Skip to content

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

prj.ads, prj.adb: Update Project Manager to new attribute names for gprbuild. 

2007-08-14  Vincent Celier  <celier@adacore.com>

	* prj.ads, prj.adb: Update Project Manager to new attribute names for
	gprbuild.
	Allow all valid declarations in configuration project files
	(Reset): Initialize all tables and hash tables in the project tree data
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.
	(Slash_Id): Change type to be Path_Name_Type
	(Slash): Return a Path_Name_Type instead of a File_Name_Type

	* prj-attr.ads, prj-attr.adb: Remove attributes no longer used by
	gprbuild.
	Update Project Manager to new attribute names for ghprbuild
	Allow all valid declarations in configuration project files
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.

	* prj-com.ads: 
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.

	* prj-dect.adb (Prj.Strt.Attribute_Reference): Set correctly the case
	insensitive flag for attributes with optional index.
	(Prj.Dect.Parse_Attribute_Declaration): For case insensitive associative
	array attribute, put the index in lower case.
	Update Project Manager to new attribute names for ghprbuild
	Allow all valid declarations in configuration project files
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.

	* prj-env.ads, prj-env.adb: 
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.
	(Get_Reference): Change type of parameter Path to Path_Name_Type

	* prj-ext.ads, prj-ext.adb (Initialize_Project_Path): Make sure, after
	removing '-' from the path to start with the first character of the
	next directory.
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.

	* prj-nmsc.ads, prj-nmsc.adb: 
	Update Project Manager to new attribute names for ghprbuild
	Allow all valid declarations in configuration project files
	(Search_Directories): Detect subunits that are specified with an
	attribute Body in package Naming. Do not replace a source/unit in the
	same project when the order of the source dirs are known. Detect
	duplicate sources/units in the same project when the order of the
	source dirs are not known.
	(Check_Ada_Name): Allow all identifiers that are not reserved words
	in Ada 95.
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.
	(Look_For_Sources): If the list of sources is empty, set the object
	directory of non extending project to nil.
	Change type of path name variables to be Path_Name_Type
	(Locate_Directory): Make sure that on Windows '/' is converted to '\',
	otherwise creating missing directories will fail.

	* prj-attr-pm.adb, prj-tree.ads, prj-proc.ads, prj-proc.adb, 
	prj-part.ads, prj-part.adb:
	Major update of the Project Manager and of the project aware tools,
	including gprmake, so that the same sources in the GNAT repository
	can be used by gprbuild.

	* prj-strt.adb (Prj.Strt.Attribute_Reference): Set correctly the case
	insensitive flag for attributes with optional index.
	(Prj.Dect.Parse_Attribute_Declaration): For case insensitive associative
	array attribute, put the index in lower case.
	(Parse_Variable_Reference): Allow the current project name to be used in
	the prefix of an attribute reference.

	* prj-util.ads, prj-util.adb
	(Value_Of (for arrays)): New Boolean parameter Force_Lower_Case_Index,
	defaulted to False. When True, always check against indexes in lower
	case.

	* snames.ads, snames.h, snames.adb: 
	Update Project Manager to new attribute names for gprbuild
	Allow all valid declarations in configuration project files

From-SVN: r127420
parent 86cde7b1
Showing with 3894 additions and 1809 deletions
gcc/ada/prj-attr-pm.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004 Free Software Foundation, Inc. -- -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -45,6 +45,7 @@ package body Prj.Attr.PM is ...@@ -45,6 +45,7 @@ package body Prj.Attr.PM is
Var_Kind => Undefined, Var_Kind => Undefined,
Optional_Index => False, Optional_Index => False,
Attr_Kind => Unknown, Attr_Kind => Unknown,
Read_Only => False,
Next => Next =>
Package_Attributes.Table (To_Package.Value).First_Attribute); Package_Attributes.Table (To_Package.Value).First_Attribute);
Package_Attributes.Table (To_Package.Value).First_Attribute := Package_Attributes.Table (To_Package.Value).First_Attribute :=
...@@ -62,7 +63,9 @@ package body Prj.Attr.PM is ...@@ -62,7 +63,9 @@ package body Prj.Attr.PM is
Package_Attributes.Increment_Last; Package_Attributes.Increment_Last;
Id := (Value => Package_Attributes.Last); Id := (Value => Package_Attributes.Last);
Package_Attributes.Table (Id.Value) := Package_Attributes.Table (Id.Value) :=
(Name => Name, Known => False, First_Attribute => Empty_Attr); (Name => Name,
Known => False,
First_Attribute => Empty_Attr);
end Add_Unknown_Package; end Add_Unknown_Package;
end Prj.Attr.PM; end Prj.Attr.PM;
gcc/ada/prj-attr.adb
...@@ -32,11 +32,11 @@ package body Prj.Attr is ...@@ -32,11 +32,11 @@ package body Prj.Attr is
-- Data for predefined attributes and packages -- Data for predefined attributes and packages
-- Names end with '#' -- Names are in lower case and end with '#'
-- Package names are preceded by 'P' -- Package names are preceded by 'P'
-- Attribute names are preceded by two letters: -- Attribute names are preceded by two or three letters:
-- The first letter is one of -- The first letter is one of
-- 'S' for Single -- 'S' for Single
...@@ -52,18 +52,38 @@ package body Prj.Attr is ...@@ -52,18 +52,38 @@ package body Prj.Attr is
-- insensitive -- insensitive
-- 'c' same as 'b', with optional index -- 'c' same as 'b', with optional index
-- The third optional letter is
-- 'R' to indicate that the attribute is read-only
-- End is indicated by two consecutive '#' -- End is indicated by two consecutive '#'
Initialization_Data : constant String := Initialization_Data : constant String :=
-- project attributes -- project level attributes
-- General
"SVRname#" &
"lVmain#" &
"LVlanguages#" &
"SVmain_language#" &
"Laroots#" &
"SVexternally_built#" &
-- Directories
"SVobject_dir#" & "SVobject_dir#" &
"SVexec_dir#" & "SVexec_dir#" &
"LVsource_dirs#" & "LVsource_dirs#" &
-- Source files
"LVsource_files#" & "LVsource_files#" &
"LVlocally_removed_files#" & "LVlocally_removed_files#" &
"SVsource_list_file#" & "SVsource_list_file#" &
-- Libraries
"SVlibrary_dir#" & "SVlibrary_dir#" &
"SVlibrary_name#" & "SVlibrary_name#" &
"SVlibrary_kind#" & "SVlibrary_kind#" &
...@@ -77,11 +97,35 @@ package body Prj.Attr is ...@@ -77,11 +97,35 @@ package body Prj.Attr is
"SVlibrary_symbol_file#" & "SVlibrary_symbol_file#" &
"SVlibrary_symbol_policy#" & "SVlibrary_symbol_policy#" &
"SVlibrary_reference_symbol_file#" & "SVlibrary_reference_symbol_file#" &
"lVmain#" &
"LVlanguages#" & -- Configuration - General
"SVmain_language#" &
"LVada_roots#" & "SVdefault_language#" &
"SVexternally_built#" & "LVrun_path_option#" &
"Satoolchain_version#" &
"Satoolchain_description#" &
-- Configuration - Libraries
"SVlibrary_builder#" &
"SVlibrary_support#" &
-- Configuration - Archives
"LVarchive_builder#" &
"LVarchive_indexer#" &
"SVarchive_suffix#" &
"LVlibrary_partial_linker#" &
-- Configuration - Shared libraries
"SVshared_library_prefix#" &
"SVshared_library_suffix#" &
"SVsymbolic_link_supported#" &
"SVlibrary_major_minor_id_supported#" &
"SVlibrary_auto_init_supported#" &
"LVshared_library_minimum_switches#" &
"LVlibrary_version_switches#" &
-- package Naming -- package Naming
...@@ -106,6 +150,38 @@ package body Prj.Attr is ...@@ -106,6 +150,38 @@ package body Prj.Attr is
"Ladefault_switches#" & "Ladefault_switches#" &
"Lcswitches#" & "Lcswitches#" &
"SVlocal_configuration_pragmas#" & "SVlocal_configuration_pragmas#" &
"Salocal_config_file#" &
-- Configuration - Compiling
"Sadriver#" &
"Lapic_option#" &
-- Configuration - Mapping files
"Lamapping_file_switches#" &
"Samapping_spec_suffix#" &
"Samapping_body_suffix#" &
-- Configuration - Config files
"Laconfig_file_switches#" &
"Saconfig_body_file_name#" &
"Saconfig_spec_file_name#" &
"Saconfig_body_file_name_pattern#" &
"Saconfig_spec_file_name_pattern#" &
"Saconfig_file_unique#" &
-- Configuration - Dependencies
"Ladependency_switches#" &
"Lacompute_dependency#" &
-- Configuration - Search paths
"Lainclude_switches#" &
"Sainclude_path#" &
"Sainclude_path_file#" &
-- package Builder -- package Builder
...@@ -115,6 +191,7 @@ package body Prj.Attr is ...@@ -115,6 +191,7 @@ package body Prj.Attr is
"Scexecutable#" & "Scexecutable#" &
"SVexecutable_suffix#" & "SVexecutable_suffix#" &
"SVglobal_configuration_pragmas#" & "SVglobal_configuration_pragmas#" &
"Saglobal_config_file#" &
-- package gnatls -- package gnatls
...@@ -127,13 +204,28 @@ package body Prj.Attr is ...@@ -127,13 +204,28 @@ package body Prj.Attr is
"Ladefault_switches#" & "Ladefault_switches#" &
"Lcswitches#" & "Lcswitches#" &
-- Configuration - Binding
"Sadriver#" &
"Saprefix#" &
"Saobjects_path#" &
"Saobjects_path_file#" &
-- package Linker -- package Linker
"Plinker#" & "Plinker#" &
"LVrequired_switches#" &
"Ladefault_switches#" & "Ladefault_switches#" &
"Lcswitches#" & "Lcswitches#" &
"LVlinker_options#" & "LVlinker_options#" &
-- Configuration - Linking
"SVdriver#" &
"LVexecutable_switch#" &
"SVlib_dir_switch#" &
"SVlib_name_switch#" &
-- package Cross_Reference -- package Cross_Reference
"Pcross_reference#" & "Pcross_reference#" &
...@@ -195,17 +287,6 @@ package body Prj.Attr is ...@@ -195,17 +287,6 @@ package body Prj.Attr is
"Pstack#" & "Pstack#" &
"LVswitches#" & "LVswitches#" &
-- package Language_Processing
"Planguage_processing#" &
"Lacompiler_driver#" &
"Sacompiler_kind#" &
"Ladependency_option#" &
"Lacompute_dependency#" &
"Lainclude_option#" &
"Sabinder_driver#" &
"SVdefault_linker#" &
"#"; "#";
Initialized : Boolean := False; Initialized : Boolean := False;
...@@ -278,6 +359,7 @@ package body Prj.Attr is ...@@ -278,6 +359,7 @@ package body Prj.Attr is
Package_Name : Name_Id := No_Name; Package_Name : Name_Id := No_Name;
Attribute_Name : Name_Id := No_Name; Attribute_Name : Name_Id := No_Name;
First_Attribute : Attr_Node_Id := Attr.First_Attribute; First_Attribute : Attr_Node_Id := Attr.First_Attribute;
Read_Only : Boolean;
function Attribute_Location return String; function Attribute_Location return String;
-- Returns a string depending if we are in the project level attributes -- Returns a string depending if we are in the project level attributes
...@@ -402,6 +484,15 @@ package body Prj.Attr is ...@@ -402,6 +484,15 @@ package body Prj.Attr is
end case; end case;
Start := Start + 1; Start := Start + 1;
if Initialization_Data (Start) = 'R' then
Read_Only := True;
Start := Start + 1;
else
Read_Only := False;
end if;
Finish := Start; Finish := Start;
while Initialization_Data (Finish) /= '#' loop while Initialization_Data (Finish) /= '#' loop
...@@ -441,6 +532,7 @@ package body Prj.Attr is ...@@ -441,6 +532,7 @@ package body Prj.Attr is
Var_Kind => Var_Kind, Var_Kind => Var_Kind,
Optional_Index => Optional_Index, Optional_Index => Optional_Index,
Attr_Kind => Attr_Kind, Attr_Kind => Attr_Kind,
Read_Only => Read_Only,
Next => Empty_Attr); Next => Empty_Attr);
Start := Finish + 1; Start := Finish + 1;
end if; end if;
...@@ -449,6 +541,15 @@ package body Prj.Attr is ...@@ -449,6 +541,15 @@ package body Prj.Attr is
Initialized := True; Initialized := True;
end Initialize; end Initialize;
------------------
-- Is_Read_Only --
------------------
function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean is
begin
return Attrs.Table (Attribute.Value).Read_Only;
end Is_Read_Only;
---------------- ----------------
-- Name_Id_Of -- -- Name_Id_Of --
---------------- ----------------
...@@ -582,6 +683,7 @@ package body Prj.Attr is ...@@ -582,6 +683,7 @@ package body Prj.Attr is
Var_Kind => Var_Kind, Var_Kind => Var_Kind,
Optional_Index => Opt_Index, Optional_Index => Opt_Index,
Attr_Kind => Real_Attr_Kind, Attr_Kind => Real_Attr_Kind,
Read_Only => False,
Next => First_Attr); Next => First_Attr);
Package_Attributes.Table (In_Package.Value).First_Attribute := Package_Attributes.Table (In_Package.Value).First_Attribute :=
Attrs.Last; Attrs.Last;
...@@ -615,7 +717,9 @@ package body Prj.Attr is ...@@ -615,7 +717,9 @@ package body Prj.Attr is
Package_Attributes.Increment_Last; Package_Attributes.Increment_Last;
Id := (Value => Package_Attributes.Last); Id := (Value => Package_Attributes.Last);
Package_Attributes.Table (Package_Attributes.Last) := Package_Attributes.Table (Package_Attributes.Last) :=
(Name => Pkg_Name, Known => True, First_Attribute => Empty_Attr); (Name => Pkg_Name,
Known => True,
First_Attribute => Empty_Attr);
end Register_New_Package; end Register_New_Package;
procedure Register_New_Package procedure Register_New_Package
...@@ -682,13 +786,16 @@ package body Prj.Attr is ...@@ -682,13 +786,16 @@ package body Prj.Attr is
Var_Kind => Attributes (Index).Var_Kind, Var_Kind => Attributes (Index).Var_Kind,
Optional_Index => Attributes (Index).Opt_Index, Optional_Index => Attributes (Index).Opt_Index,
Attr_Kind => Attr_Kind, Attr_Kind => Attr_Kind,
Read_Only => False,
Next => First_Attr); Next => First_Attr);
First_Attr := Attrs.Last; First_Attr := Attrs.Last;
end loop; end loop;
Package_Attributes.Increment_Last; Package_Attributes.Increment_Last;
Package_Attributes.Table (Package_Attributes.Last) := Package_Attributes.Table (Package_Attributes.Last) :=
(Name => Pkg_Name, Known => True, First_Attribute => First_Attr); (Name => Pkg_Name,
Known => True,
First_Attribute => First_Attr);
end Register_New_Package; end Register_New_Package;
--------------------------- ---------------------------
......
gcc/ada/prj-attr.ads
...@@ -153,6 +153,8 @@ package Prj.Attr is ...@@ -153,6 +153,8 @@ package Prj.Attr is
-- Returns True if Attribute is a known attribute and may have an -- Returns True if Attribute is a known attribute and may have an
-- optional index. Returns False otherwise. -- optional index. Returns False otherwise.
function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean;
function Next_Attribute function Next_Attribute
(After : Attribute_Node_Id) return Attribute_Node_Id; (After : Attribute_Node_Id) return Attribute_Node_Id;
-- Returns the attribute that follow After in the list of project level -- Returns the attribute that follow After in the list of project level
...@@ -269,13 +271,13 @@ private ...@@ -269,13 +271,13 @@ private
Var_Kind : Variable_Kind; Var_Kind : Variable_Kind;
Optional_Index : Boolean; Optional_Index : Boolean;
Attr_Kind : Attribute_Kind; Attr_Kind : Attribute_Kind;
Read_Only : Boolean;
Next : Attr_Node_Id; Next : Attr_Node_Id;
end record; end record;
-- Data for an attribute -- Data for an attribute
package Attrs is package Attrs is
new Table.Table new Table.Table (Table_Component_Type => Attribute_Record,
(Table_Component_Type => Attribute_Record,
Table_Index_Type => Attr_Node_Id, Table_Index_Type => Attr_Node_Id,
Table_Low_Bound => First_Attribute, Table_Low_Bound => First_Attribute,
Table_Initial => Attributes_Initial, Table_Initial => Attributes_Initial,
...@@ -295,8 +297,7 @@ private ...@@ -295,8 +297,7 @@ private
-- Data for a package -- Data for a package
package Package_Attributes is package Package_Attributes is
new Table.Table new Table.Table (Table_Component_Type => Package_Record,
(Table_Component_Type => Package_Record,
Table_Index_Type => Pkg_Node_Id, Table_Index_Type => Pkg_Node_Id,
Table_Low_Bound => First_Package, Table_Low_Bound => First_Package,
Table_Initial => Packages_Initial, Table_Initial => Packages_Initial,
......
gcc/ada/prj-com.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -24,10 +24,8 @@ ...@@ -24,10 +24,8 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- The following package declares data types for GNAT project. -- The following package declares a Fail procedure that is used in the
-- These data types are used in the bodies of the Prj hierarchy. -- Project Manager.
-- Above comment seems *far* too general ???
with Osint; with Osint;
......
gcc/ada/prj-dect.adb
...@@ -25,13 +25,16 @@ ...@@ -25,13 +25,16 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Err_Vars; use Err_Vars; with Err_Vars; use Err_Vars;
with GNAT.Case_Util; use GNAT.Case_Util;
with Opt; use Opt; with Opt; use Opt;
with Prj.Attr; use Prj.Attr;
with Prj.Attr.PM; use Prj.Attr.PM;
with Prj.Err; use Prj.Err; with Prj.Err; use Prj.Err;
with Prj.Strt; use Prj.Strt; with Prj.Strt; use Prj.Strt;
with Prj.Tree; use Prj.Tree; with Prj.Tree; use Prj.Tree;
with Snames; with Snames;
with Prj.Attr; use Prj.Attr;
with Prj.Attr.PM; use Prj.Attr.PM;
with Uintp; use Uintp; with Uintp; use Uintp;
package body Prj.Dect is package body Prj.Dect is
...@@ -214,12 +217,20 @@ package body Prj.Dect is ...@@ -214,12 +217,20 @@ package body Prj.Dect is
-- Set, if appropriate the index case insensitivity flag -- Set, if appropriate the index case insensitivity flag
elsif Attribute_Kind_Of (Current_Attribute) in else
if Is_Read_Only (Current_Attribute) then
Error_Msg
("read-only attribute cannot be given a value",
Token_Ptr);
end if;
if Attribute_Kind_Of (Current_Attribute) in
Case_Insensitive_Associative_Array .. Case_Insensitive_Associative_Array ..
Optional_Index_Case_Insensitive_Associative_Array Optional_Index_Case_Insensitive_Associative_Array
then then
Set_Case_Insensitive (Attribute, In_Tree, To => True); Set_Case_Insensitive (Attribute, In_Tree, To => True);
end if; end if;
end if;
Scan (In_Tree); -- past the attribute name Scan (In_Tree); -- past the attribute name
end if; end if;
...@@ -272,7 +283,13 @@ package body Prj.Dect is ...@@ -272,7 +283,13 @@ package body Prj.Dect is
Expect (Tok_String_Literal, "literal string"); Expect (Tok_String_Literal, "literal string");
if Token = Tok_String_Literal then if Token = Tok_String_Literal then
Set_Associative_Array_Index_Of (Attribute, In_Tree, Token_Name); Get_Name_String (Token_Name);
if Case_Insensitive (Attribute, In_Tree) then
To_Lower (Name_Buffer (1 .. Name_Len));
end if;
Set_Associative_Array_Index_Of (Attribute, In_Tree, Name_Find);
Scan (In_Tree); -- past the literal string index Scan (In_Tree); -- past the literal string index
if Token = Tok_At then if Token = Tok_At then
...@@ -996,6 +1013,10 @@ package body Prj.Dect is ...@@ -996,6 +1013,10 @@ package body Prj.Dect is
end if; end if;
if Token = Tok_Renames then if Token = Tok_Renames then
if In_Configuration then
Error_Msg
("no package renames in configuration projects", Token_Ptr);
end if;
-- Scan past "renames" -- Scan past "renames"
...@@ -1130,7 +1151,7 @@ package body Prj.Dect is ...@@ -1130,7 +1151,7 @@ package body Prj.Dect is
and then Token_Name /= Name_Of (Package_Declaration, In_Tree) and then Token_Name /= Name_Of (Package_Declaration, In_Tree)
then then
Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree); Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree);
Error_Msg ("expected %", Token_Ptr); Error_Msg ("expected %%", Token_Ptr);
end if; end if;
if Token /= Tok_Semicolon then if Token /= Tok_Semicolon then
......
gcc/ada/prj-env.adb
...@@ -35,15 +35,16 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; ...@@ -35,15 +35,16 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
package body Prj.Env is package body Prj.Env is
Current_Source_Path_File : Path_Name_Type := No_Path; Current_Source_Path_File : Path_Name_Type := No_Path;
-- Current value of project source path file env var. Used to avoid setting -- Current value of project source path file env var.
-- the env var to the same value. -- Used to avoid setting the env var to the same value.
Current_Object_Path_File : Path_Name_Type := No_Path; Current_Object_Path_File : Path_Name_Type := No_Path;
-- Current value of project object path file env var. Used to avoid setting -- Current value of project object path file env var.
-- the env var to the same value. -- Used to avoid setting the env var to the same value.
Ada_Path_Buffer : String_Access := new String (1 .. 1024); Ada_Path_Buffer : String_Access := new String (1 .. 1024);
-- buffer where values for ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are stored -- A buffer where values for ADA_INCLUDE_PATH
-- and ADA_OBJECTS_PATH are stored.
Ada_Path_Length : Natural := 0; Ada_Path_Length : Natural := 0;
-- Index of the last valid character in Ada_Path_Buffer -- Index of the last valid character in Ada_Path_Buffer
...@@ -69,13 +70,13 @@ package body Prj.Env is ...@@ -69,13 +70,13 @@ package body Prj.Env is
----------------------- -----------------------
function Body_Path_Name_Of function Body_Path_Name_Of
(Unit : Unit_Id; (Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String; In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the body of a unit. -- Returns the path name of the body of a unit.
-- Compute it first, if necessary. -- Compute it first, if necessary.
function Spec_Path_Name_Of function Spec_Path_Name_Of
(Unit : Unit_Id; (Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String; In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the spec of a unit. -- Returns the path name of the spec of a unit.
-- Compute it first, if necessary. -- Compute it first, if necessary.
...@@ -88,13 +89,14 @@ package body Prj.Env is ...@@ -88,13 +89,14 @@ package body Prj.Env is
procedure Add_To_Path (Dir : String); procedure Add_To_Path (Dir : String);
-- If Dir is not already in the global variable Ada_Path_Buffer, add it. -- If Dir is not already in the global variable Ada_Path_Buffer, add it.
-- Increment Ada_Path_Length. If Ada_Path_Length /= 0, prepend a -- Increment Ada_Path_Length.
-- Path_Separator character to Path. -- If Ada_Path_Length /= 0, prepend a Path_Separator character to
-- Path.
procedure Add_To_Source_Path procedure Add_To_Source_Path
(Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref); (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref);
-- Add to Ada_Path_B all the source directories in string list Source_Dirs, -- Add to Ada_Path_B all the source directories in string list
-- if any. Increment Ada_Path_Length. -- Source_Dirs, if any. Increment Ada_Path_Length.
procedure Add_To_Object_Path procedure Add_To_Object_Path
(Object_Dir : Path_Name_Type; (Object_Dir : Path_Name_Type;
...@@ -105,13 +107,6 @@ package body Prj.Env is ...@@ -105,13 +107,6 @@ package body Prj.Env is
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean; function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean;
-- Return True if there is at least one ALI file in the directory Dir -- Return True if there is at least one ALI file in the directory Dir
procedure Create_New_Path_File
(In_Tree : Project_Tree_Ref;
Path_FD : out File_Descriptor;
Path_Name : out Path_Name_Type);
-- Create a new temporary path file. Get the file name in Path_Name. The
-- name is normally obtained by increasing Temp_Path_File_Name by 1.
procedure Set_Path_File_Var (Name : String; Value : String); procedure Set_Path_File_Var (Name : String; Value : String);
-- Call Setenv, after calling To_Host_File_Spec -- Call Setenv, after calling To_Host_File_Spec
...@@ -329,8 +324,7 @@ package body Prj.Env is ...@@ -329,8 +324,7 @@ package body Prj.Env is
------------------------ ------------------------
procedure Add_To_Object_Path procedure Add_To_Object_Path
(Object_Dir : Path_Name_Type; (Object_Dir : Path_Name_Type; In_Tree : Project_Tree_Ref)
In_Tree : Project_Tree_Ref)
is is
begin begin
-- Check if the directory is already in the table -- Check if the directory is already in the table
...@@ -491,7 +485,7 @@ package body Prj.Env is ...@@ -491,7 +485,7 @@ package body Prj.Env is
-- If it is already, no need to add it -- If it is already, no need to add it
if In_Tree.Private_Part.Source_Paths.Table (Index) = if In_Tree.Private_Part.Source_Paths.Table (Index) =
File_Name_Type (Source_Dir.Value) Source_Dir.Value
then then
Add_It := False; Add_It := False;
exit; exit;
...@@ -503,7 +497,7 @@ package body Prj.Env is ...@@ -503,7 +497,7 @@ package body Prj.Env is
(In_Tree.Private_Part.Source_Paths); (In_Tree.Private_Part.Source_Paths);
In_Tree.Private_Part.Source_Paths.Table In_Tree.Private_Part.Source_Paths.Table
(Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) := (Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) :=
File_Name_Type (Source_Dir.Value); Source_Dir.Value;
end if; end if;
-- Next source directory -- Next source directory
...@@ -517,7 +511,8 @@ package body Prj.Env is ...@@ -517,7 +511,8 @@ package body Prj.Env is
----------------------- -----------------------
function Body_Path_Name_Of function Body_Path_Name_Of
(Unit : Unit_Id; In_Tree : Project_Tree_Ref) return String (Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String
is is
Data : Unit_Data := In_Tree.Units.Table (Unit); Data : Unit_Data := In_Tree.Units.Table (Unit);
...@@ -525,18 +520,18 @@ package body Prj.Env is ...@@ -525,18 +520,18 @@ package body Prj.Env is
-- If we don't know the path name of the body of this unit, -- If we don't know the path name of the body of this unit,
-- we compute it, and we store it. -- we compute it, and we store it.
if Data.File_Names (Body_Part).Path = No_File then if Data.File_Names (Body_Part).Path = No_Path then
declare declare
Current_Source : String_List_Id := Current_Source : String_List_Id :=
In_Tree.Projects.Table In_Tree.Projects.Table
(Data.File_Names (Body_Part).Project).Sources; (Data.File_Names (Body_Part).Project).Ada_Sources;
Path : GNAT.OS_Lib.String_Access; Path : GNAT.OS_Lib.String_Access;
begin begin
-- By default, put the file name -- By default, put the file name
Data.File_Names (Body_Part).Path := Data.File_Names (Body_Part).Path :=
Data.File_Names (Body_Part).Name; Path_Name_Type (Data.File_Names (Body_Part).Name);
-- For each source directory -- For each source directory
...@@ -581,7 +576,7 @@ package body Prj.Env is ...@@ -581,7 +576,7 @@ package body Prj.Env is
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is
Dir_Name : constant String := Get_Name_String (Dir); Dir_Name : constant String := Get_Name_String (Dir);
Direct : Dir_Type; Direct : Dir_Type;
Name : String (1 .. 1_000); -- what is this magic constant 1000 ??? Name : String (1 .. 1_000);
Last : Natural; Last : Natural;
Result : Boolean := False; Result : Boolean := False;
...@@ -629,7 +624,7 @@ package body Prj.Env is ...@@ -629,7 +624,7 @@ package body Prj.Env is
File_Name : Path_Name_Type := No_Path; File_Name : Path_Name_Type := No_Path;
File : File_Descriptor := Invalid_FD; File : File_Descriptor := Invalid_FD;
Current_Unit : Unit_Id := Unit_Table.First; Current_Unit : Unit_Index := Unit_Table.First;
First_Project : Project_List := Empty_Project_List; First_Project : Project_List := Empty_Project_List;
...@@ -731,7 +726,7 @@ package body Prj.Env is ...@@ -731,7 +726,7 @@ package body Prj.Env is
(File, "pragma Source_File_Name_Project"); (File, "pragma Source_File_Name_Project");
Put_Line Put_Line
(File, " (Spec_File_Name => ""*" & (File, " (Spec_File_Name => ""*" &
Namet.Get_Name_String (Data.Naming.Ada_Spec_Suffix) & Spec_Suffix_Of (In_Tree, "ada", Data.Naming) &
""","); """,");
Put_Line Put_Line
(File, " Casing => " & (File, " Casing => " &
...@@ -747,7 +742,7 @@ package body Prj.Env is ...@@ -747,7 +742,7 @@ package body Prj.Env is
(File, "pragma Source_File_Name_Project"); (File, "pragma Source_File_Name_Project");
Put_Line Put_Line
(File, " (Body_File_Name => ""*" & (File, " (Body_File_Name => ""*" &
Namet.Get_Name_String (Data.Naming.Ada_Body_Suffix) & Body_Suffix_Of (In_Tree, "ada", Data.Naming) &
""","); """,");
Put_Line Put_Line
(File, " Casing => " & (File, " Casing => " &
...@@ -759,8 +754,8 @@ package body Prj.Env is ...@@ -759,8 +754,8 @@ package body Prj.Env is
-- and maybe separate -- and maybe separate
if if Body_Suffix_Of (In_Tree, "ada", Data.Naming) /=
Data.Naming.Ada_Body_Suffix /= Data.Naming.Separate_Suffix Get_Name_String (Data.Naming.Separate_Suffix)
then then
Put_Line Put_Line
(File, "pragma Source_File_Name_Project"); (File, "pragma Source_File_Name_Project");
...@@ -810,12 +805,17 @@ package body Prj.Env is ...@@ -810,12 +805,17 @@ package body Prj.Env is
if File = Invalid_FD then if File = Invalid_FD then
Prj.Com.Fail Prj.Com.Fail
("unable to create temporary configuration pragmas file"); ("unable to create temporary configuration pragmas file");
elsif Opt.Verbose_Mode then
else
Record_Temp_File (File_Name);
if Opt.Verbose_Mode then
Write_Str ("Creating temp file """); Write_Str ("Creating temp file """);
Write_Str (Get_Name_String (File_Name)); Write_Str (Get_Name_String (File_Name));
Write_Line (""""); Write_Line ("""");
end if; end if;
end if; end if;
end if;
end Check_Temp_File; end Check_Temp_File;
--------- ---------
...@@ -1117,11 +1117,15 @@ package body Prj.Env is ...@@ -1117,11 +1117,15 @@ package body Prj.Env is
if File = Invalid_FD then if File = Invalid_FD then
Prj.Com.Fail ("unable to create temporary mapping file"); Prj.Com.Fail ("unable to create temporary mapping file");
elsif Opt.Verbose_Mode then else
Record_Temp_File (Name);
if Opt.Verbose_Mode then
Write_Str ("Creating temp mapping file """); Write_Str ("Creating temp mapping file """);
Write_Str (Get_Name_String (Name)); Write_Str (Get_Name_String (Name));
Write_Line (""""); Write_Line ("""");
end if; end if;
end if;
if Fill_Mapping_File then if Fill_Mapping_File then
...@@ -1162,6 +1166,164 @@ package body Prj.Env is ...@@ -1162,6 +1166,164 @@ package body Prj.Env is
end if; end if;
end Create_Mapping_File; end Create_Mapping_File;
procedure Create_Mapping_File
(Project : Project_Id;
Language : Name_Id;
Runtime : Project_Id;
In_Tree : Project_Tree_Ref;
Name : out Path_Name_Type)
is
File : File_Descriptor := Invalid_FD;
Status : Boolean;
-- For call to Close
Present : Project_Flags
(No_Project .. Project_Table.Last (In_Tree.Projects)) :=
(others => False);
-- For each project in the closure of Project, the corresponding flag
-- will be set to True.
Source : Source_Id;
Src_Data : Source_Data;
Suffix : File_Name_Type;
procedure Put_Name_Buffer;
-- Put the line contained in the Name_Buffer in the mapping file
procedure Recursive_Flag (Prj : Project_Id);
-- Set the flags corresponding to Prj, the projects it imports
-- (directly or indirectly) or extends to True. Call itself recursively.
---------
-- Put --
---------
procedure Put_Name_Buffer is
Last : Natural;
begin
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Last := Write (File, Name_Buffer (1)'Address, Name_Len);
if Last /= Name_Len then
Prj.Com.Fail ("Disk full");
end if;
end Put_Name_Buffer;
--------------------
-- Recursive_Flag --
--------------------
procedure Recursive_Flag (Prj : Project_Id) is
Imported : Project_List;
Proj : Project_Id;
begin
-- Nothing to do for non existent or runtime project or project
-- that has already been flagged.
if Prj = No_Project or else Prj = Runtime or else Present (Prj) then
return;
end if;
-- Flag the current project
Present (Prj) := True;
Imported :=
In_Tree.Projects.Table (Prj).Imported_Projects;
-- Call itself for each project directly imported
while Imported /= Empty_Project_List loop
Proj :=
In_Tree.Project_Lists.Table (Imported).Project;
Imported :=
In_Tree.Project_Lists.Table (Imported).Next;
Recursive_Flag (Proj);
end loop;
-- Call itself for an eventual project being extended
Recursive_Flag (In_Tree.Projects.Table (Prj).Extends);
end Recursive_Flag;
-- Start of processing for Create_Mapping_File
begin
-- Flag the necessary projects
Recursive_Flag (Project);
-- Create the temporary file
Tempdir.Create_Temp_File (File, Name => Name);
if File = Invalid_FD then
Prj.Com.Fail ("unable to create temporary mapping file");
else
Record_Temp_File (Name);
if Opt.Verbose_Mode then
Write_Str ("Creating temp mapping file """);
Write_Str (Get_Name_String (Name));
Write_Line ("""");
end if;
end if;
-- For all source of the Language of all projects in the closure
for Proj in Present'Range loop
if Present (Proj) then
Source := In_Tree.Projects.Table (Proj).First_Source;
while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source);
if Src_Data.Language_Name = Language and then
(not Src_Data.Locally_Removed) and then
Src_Data.Replaced_By = No_Source
then
if Src_Data.Unit /= No_Name then
Get_Name_String (Src_Data.Unit);
if Src_Data.Kind = Spec then
Suffix := In_Tree.Languages_Data.Table
(Src_Data.Language).Config.Mapping_Spec_Suffix;
else
Suffix := In_Tree.Languages_Data.Table
(Src_Data.Language).Config.Mapping_Body_Suffix;
end if;
if Suffix /= No_File then
Add_Str_To_Name_Buffer (Get_Name_String (Suffix));
end if;
Put_Name_Buffer;
end if;
Get_Name_String (Src_Data.File);
Put_Name_Buffer;
Get_Name_String (Src_Data.Path);
Put_Name_Buffer;
end if;
Source := Src_Data.Next_In_Project;
end loop;
end if;
end loop;
GNAT.OS_Lib.Close (File, Status);
if not Status then
Prj.Com.Fail ("disk full");
end if;
end Create_Mapping_File;
-------------------------- --------------------------
-- Create_New_Path_File -- -- Create_New_Path_File --
-------------------------- --------------------------
...@@ -1175,9 +1337,10 @@ package body Prj.Env is ...@@ -1175,9 +1337,10 @@ package body Prj.Env is
Tempdir.Create_Temp_File (Path_FD, Path_Name); Tempdir.Create_Temp_File (Path_FD, Path_Name);
if Path_Name /= No_Path then if Path_Name /= No_Path then
Record_Temp_File (Path_Name);
-- Record the name, so that the temp path file will be deleted -- Record the name, so that the temp path file will be deleted at the
-- at the end of the program. -- end of the program.
Path_File_Table.Increment_Last (In_Tree.Private_Part.Path_Files); Path_File_Table.Increment_Last (In_Tree.Private_Part.Path_Files);
In_Tree.Private_Part.Path_Files.Table In_Tree.Private_Part.Path_Files.Table
...@@ -1238,17 +1401,17 @@ package body Prj.Env is ...@@ -1238,17 +1401,17 @@ package body Prj.Env is
Original_Name : String := Name; Original_Name : String := Name;
Extended_Spec_Name : String := Extended_Spec_Name : String :=
Name & Namet.Get_Name_String Name &
(Data.Naming.Ada_Spec_Suffix); Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String := Extended_Body_Name : String :=
Name & Namet.Get_Name_String Name &
(Data.Naming.Ada_Body_Suffix); Body_Suffix_Of (In_Tree, "ada", Data.Naming);
Unit : Unit_Data; Unit : Unit_Data;
The_Original_Name : File_Name_Type; The_Original_Name : Name_Id;
The_Spec_Name : File_Name_Type; The_Spec_Name : Name_Id;
The_Body_Name : File_Name_Type; The_Body_Name : Name_Id;
begin begin
Canonical_Case_File_Name (Original_Name); Canonical_Case_File_Name (Original_Name);
...@@ -1281,9 +1444,9 @@ package body Prj.Env is ...@@ -1281,9 +1444,9 @@ package body Prj.Env is
Write_Eol; Write_Eol;
end if; end if;
-- For extending project, search in the extended project -- For extending project, search in the extended project if the source
-- if the source is not found. For non extending projects, -- is not found. For non extending projects, this loop will be run only
-- this loop will be run only once. -- once.
loop loop
-- Loop through units -- Loop through units
...@@ -1317,9 +1480,9 @@ package body Prj.Env is ...@@ -1317,9 +1480,9 @@ package body Prj.Env is
-- If it has the name of the original name, return the -- If it has the name of the original name, return the
-- original name. -- original name.
if Name_Id (Unit.Name) = Name_Id (The_Original_Name) if Unit.Name = The_Original_Name
-- Type confusion in above comparison ??? or else
or else Current_Name = The_Original_Name Current_Name = File_Name_Type (The_Original_Name)
then then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line (" OK"); Write_Line (" OK");
...@@ -1336,7 +1499,7 @@ package body Prj.Env is ...@@ -1336,7 +1499,7 @@ package body Prj.Env is
-- If it has the name of the extended body name, -- If it has the name of the extended body name,
-- return the extended body name -- return the extended body name
elsif Current_Name = The_Body_Name then elsif Current_Name = File_Name_Type (The_Body_Name) then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line (" OK"); Write_Line (" OK");
end if; end if;
...@@ -1380,9 +1543,9 @@ package body Prj.Env is ...@@ -1380,9 +1543,9 @@ package body Prj.Env is
-- If name same as original name, return original name -- If name same as original name, return original name
if Name_Id (Unit.Name) = Name_Id (The_Original_Name) if Unit.Name = The_Original_Name
-- Type confusion in the above comparison ??? or else
or else Current_Name = The_Original_Name Current_Name = File_Name_Type (The_Original_Name)
then then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line (" OK"); Write_Line (" OK");
...@@ -1398,7 +1561,7 @@ package body Prj.Env is ...@@ -1398,7 +1561,7 @@ package body Prj.Env is
-- If it has the same name as the extended spec name, -- If it has the same name as the extended spec name,
-- return the extended spec name. -- return the extended spec name.
elsif Current_Name = The_Spec_Name then elsif Current_Name = File_Name_Type (The_Spec_Name) then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line (" OK"); Write_Line (" OK");
end if; end if;
...@@ -1446,9 +1609,9 @@ package body Prj.Env is ...@@ -1446,9 +1609,9 @@ package body Prj.Env is
Seen : Project_List := Empty_Project_List; Seen : Project_List := Empty_Project_List;
procedure Add (Project : Project_Id); procedure Add (Project : Project_Id);
-- Process a project. Remember the processes visited to avoid -- Process a project. Remember the processes visited to avoid processing
-- processing a project twice. Recursively process an eventual -- a project twice. Recursively process an eventual extended project,
-- extended project, and all imported projects. -- and all imported projects.
--------- ---------
-- Add -- -- Add --
...@@ -1464,10 +1627,8 @@ package body Prj.Env is ...@@ -1464,10 +1627,8 @@ package body Prj.Env is
-- for sure we never visited this project. -- for sure we never visited this project.
if Seen = Empty_Project_List then if Seen = Empty_Project_List then
Project_List_Table.Increment_Last Project_List_Table.Increment_Last (In_Tree.Project_Lists);
(In_Tree.Project_Lists); Seen := Project_List_Table.Last (In_Tree.Project_Lists);
Seen :=
Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Seen) := In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List); (Project => Project, Next => Empty_Project_List);
...@@ -1497,7 +1658,8 @@ package body Prj.Env is ...@@ -1497,7 +1658,8 @@ package body Prj.Env is
-- This project has never been visited, add it -- This project has never been visited, add it
-- to the list. -- to the list.
Project_List_Table.Increment_Last (In_Tree.Project_Lists); Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Current).Next := In_Tree.Project_Lists.Table (Current).Next :=
Project_List_Table.Last (In_Tree.Project_Lists); Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table In_Tree.Project_Lists.Table
...@@ -1507,8 +1669,7 @@ package body Prj.Env is ...@@ -1507,8 +1669,7 @@ package body Prj.Env is
end; end;
end if; end if;
-- If there is an object directory, call Action -- If there is an object directory, call Action with its name
-- with its name
if Data.Object_Directory /= No_Path then if Data.Object_Directory /= No_Path then
Get_Name_String (Data.Display_Object_Dir); Get_Name_String (Data.Display_Object_Dir);
...@@ -1532,8 +1693,7 @@ package body Prj.Env is ...@@ -1532,8 +1693,7 @@ package body Prj.Env is
-- Start of processing for For_All_Object_Dirs -- Start of processing for For_All_Object_Dirs
begin begin
-- Visit this project, and its imported projects, -- Visit this project, and its imported projects, recursively
-- recursively
Add (Project); Add (Project);
end For_All_Object_Dirs; end For_All_Object_Dirs;
...@@ -1549,25 +1709,28 @@ package body Prj.Env is ...@@ -1549,25 +1709,28 @@ package body Prj.Env is
Seen : Project_List := Empty_Project_List; Seen : Project_List := Empty_Project_List;
procedure Add (Project : Project_Id); procedure Add (Project : Project_Id);
-- Process a project. Remember the processes visited to avoid -- Process a project. Remember the processes visited to avoid processing
-- processing a project twice. Recursively process an eventual -- a project twice. Recursively process an eventual extended project,
-- extended project, and all imported projects. -- and all imported projects.
--------- ---------
-- Add -- -- Add --
--------- ---------
procedure Add (Project : Project_Id) is procedure Add (Project : Project_Id) is
Data : constant Project_Data := In_Tree.Projects.Table (Project); Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects; List : Project_List := Data.Imported_Projects;
begin begin
-- If the list of visited project is empty, then -- If the list of visited project is empty, then for sure we never
-- for sure we never visited this project. -- visited this project.
if Seen = Empty_Project_List then if Seen = Empty_Project_List then
Project_List_Table.Increment_Last (In_Tree.Project_Lists); Project_List_Table.Increment_Last
Seen := Project_List_Table.Last (In_Tree.Project_Lists); (In_Tree.Project_Lists);
Seen := Project_List_Table.Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Seen) := In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List); (Project => Project, Next => Empty_Project_List);
...@@ -1590,18 +1753,19 @@ package body Prj.Env is ...@@ -1590,18 +1753,19 @@ package body Prj.Env is
exit when exit when
In_Tree.Project_Lists.Table (Current).Next = In_Tree.Project_Lists.Table (Current).Next =
Empty_Project_List; Empty_Project_List;
Current :=
Current := In_Tree.Project_Lists.Table (Current).Next; In_Tree.Project_Lists.Table (Current).Next;
end loop; end loop;
-- This project has never been visited, add it -- This project has never been visited, add it to the list
-- to the list.
Project_List_Table.Increment_Last (In_Tree.Project_Lists); Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Current).Next := In_Tree.Project_Lists.Table (Current).Next :=
Project_List_Table.Last (In_Tree.Project_Lists); Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table In_Tree.Project_Lists.Table
(Project_List_Table.Last (In_Tree.Project_Lists)) := (Project_List_Table.Last
(In_Tree.Project_Lists)) :=
(Project => Project, Next => Empty_Project_List); (Project => Project, Next => Empty_Project_List);
end; end;
end if; end if;
...@@ -1614,9 +1778,12 @@ package body Prj.Env is ...@@ -1614,9 +1778,12 @@ package body Prj.Env is
-- If there are Ada sources, call action with the name of every -- If there are Ada sources, call action with the name of every
-- source directory. -- source directory.
if In_Tree.Projects.Table (Project).Ada_Sources_Present then if
In_Tree.Projects.Table (Project).Ada_Sources /= Nil_String
then
while Current /= Nil_String loop while Current /= Nil_String loop
The_String := In_Tree.String_Elements.Table (Current); The_String :=
In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value)); Action (Get_Name_String (The_String.Display_Value));
Current := The_String.Next; Current := The_String.Next;
end loop; end loop;
...@@ -1653,7 +1820,7 @@ package body Prj.Env is ...@@ -1653,7 +1820,7 @@ package body Prj.Env is
(Source_File_Name : String; (Source_File_Name : String;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Project : out Project_Id; Project : out Project_Id;
Path : out File_Name_Type) Path : out Path_Name_Type)
is is
begin begin
-- Body below could use some comments ??? -- Body below could use some comments ???
...@@ -1680,7 +1847,7 @@ package body Prj.Env is ...@@ -1680,7 +1847,7 @@ package body Prj.Env is
and then and then
Namet.Get_Name_String Namet.Get_Name_String
(Unit.File_Names (Specification).Name) = Original_Name) (Unit.File_Names (Specification).Name) = Original_Name)
or else (Unit.File_Names (Specification).Path /= No_File or else (Unit.File_Names (Specification).Path /= No_Path
and then and then
Namet.Get_Name_String Namet.Get_Name_String
(Unit.File_Names (Specification).Path) = (Unit.File_Names (Specification).Path) =
...@@ -1702,7 +1869,7 @@ package body Prj.Env is ...@@ -1702,7 +1869,7 @@ package body Prj.Env is
and then and then
Namet.Get_Name_String Namet.Get_Name_String
(Unit.File_Names (Body_Part).Name) = Original_Name) (Unit.File_Names (Body_Part).Name) = Original_Name)
or else (Unit.File_Names (Body_Part).Path /= No_File or else (Unit.File_Names (Body_Part).Path /= No_Path
and then Namet.Get_Name_String and then Namet.Get_Name_String
(Unit.File_Names (Body_Part).Path) = (Unit.File_Names (Body_Part).Path) =
Original_Name) Original_Name)
...@@ -1723,7 +1890,7 @@ package body Prj.Env is ...@@ -1723,7 +1890,7 @@ package body Prj.Env is
end; end;
Project := No_Project; Project := No_Project;
Path := No_File; Path := No_Path;
if Current_Verbosity > Default then if Current_Verbosity > Default then
Write_Str ("Cannot be found."); Write_Str ("Cannot be found.");
...@@ -1756,14 +1923,14 @@ package body Prj.Env is ...@@ -1756,14 +1923,14 @@ package body Prj.Env is
Original_Name : String := Name; Original_Name : String := Name;
Extended_Spec_Name : String := Extended_Spec_Name : String :=
Name & Namet.Get_Name_String Name &
(Data.Naming.Ada_Spec_Suffix); Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String := Extended_Body_Name : String :=
Name & Namet.Get_Name_String Name &
(Data.Naming.Ada_Body_Suffix); Body_Suffix_Of (In_Tree, "ada", Data.Naming);
First : Unit_Id; First : Unit_Index := Unit_Table.First;
Current : Unit_Id; Current : Unit_Index;
Unit : Unit_Data; Unit : Unit_Data;
begin begin
...@@ -1786,7 +1953,6 @@ package body Prj.Env is ...@@ -1786,7 +1953,6 @@ package body Prj.Env is
Write_Eol; Write_Eol;
end if; end if;
First := Unit_Table.First;
while First <= Unit_Table.Last (In_Tree.Units) while First <= Unit_Table.Last (In_Tree.Units)
and then In_Tree.Units.Table and then In_Tree.Units.Table
(First).File_Names (Body_Part).Project /= Project (First).File_Names (Body_Part).Project /= Project
...@@ -1950,11 +2116,11 @@ package body Prj.Env is ...@@ -1950,11 +2116,11 @@ package body Prj.Env is
In_Tree.Projects.Table (Main_Project); In_Tree.Projects.Table (Main_Project);
Extended_Spec_Name : String := Extended_Spec_Name : String :=
Name & Namet.Get_Name_String Name &
(Data.Naming.Ada_Spec_Suffix); Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String := Extended_Body_Name : String :=
Name & Namet.Get_Name_String Name &
(Data.Naming.Ada_Body_Suffix); Body_Suffix_Of (In_Tree, "ada", Data.Naming);
Unit : Unit_Data; Unit : Unit_Data;
...@@ -1963,8 +2129,6 @@ package body Prj.Env is ...@@ -1963,8 +2129,6 @@ package body Prj.Env is
The_Spec_Name : File_Name_Type; The_Spec_Name : File_Name_Type;
The_Body_Name : File_Name_Type; The_Body_Name : File_Name_Type;
-- Confusion here between unit names/file names, See ??? comments below
begin begin
Canonical_Case_File_Name (Original_Name); Canonical_Case_File_Name (Original_Name);
Name_Len := Original_Name'Length; Name_Len := Original_Name'Length;
...@@ -1997,7 +2161,7 @@ package body Prj.Env is ...@@ -1997,7 +2161,7 @@ package body Prj.Env is
-- If it has the name of the original name or the body name, -- If it has the name of the original name or the body name,
-- we have found the project. -- we have found the project.
if Name_Id (Unit.Name) = Name_Id (The_Original_Name) -- ??? if Unit.Name = Name_Id (The_Original_Name)
or else Current_Name = The_Original_Name or else Current_Name = The_Original_Name
or else Current_Name = The_Body_Name or else Current_Name = The_Body_Name
then then
...@@ -2015,7 +2179,7 @@ package body Prj.Env is ...@@ -2015,7 +2179,7 @@ package body Prj.Env is
-- If name same as the original name, or the spec name, we have -- If name same as the original name, or the spec name, we have
-- found the project. -- found the project.
if Name_Id (Unit.Name) = Name_Id (The_Original_Name) -- ??? if Unit.Name = Name_Id (The_Original_Name)
or else Current_Name = The_Original_Name or else Current_Name = The_Original_Name
or else Current_Name = The_Spec_Name or else Current_Name = The_Spec_Name
then then
...@@ -2092,11 +2256,11 @@ package body Prj.Env is ...@@ -2092,11 +2256,11 @@ package body Prj.Env is
begin begin
if Process_Source_Dirs then if Process_Source_Dirs then
-- Add to path all source directories of this project -- Add to path all source directories of this project if
-- if there are Ada sources. -- there are Ada sources.
if In_Tree.Projects.Table if In_Tree.Projects.Table (Project).Ada_Sources /=
(Project).Ada_Sources_Present Nil_String
then then
Add_To_Source_Path (Data.Source_Dirs, In_Tree); Add_To_Source_Path (Data.Source_Dirs, In_Tree);
end if; end if;
...@@ -2105,8 +2269,8 @@ package body Prj.Env is ...@@ -2105,8 +2269,8 @@ package body Prj.Env is
if Process_Object_Dirs then if Process_Object_Dirs then
-- Add to path the object directory of this project -- Add to path the object directory of this project
-- except if we don't include library project and -- except if we don't include library project and this
-- this is a library project. -- is a library project.
if (Data.Library and then Including_Libraries) if (Data.Library and then Including_Libraries)
or else or else
...@@ -2114,10 +2278,10 @@ package body Prj.Env is ...@@ -2114,10 +2278,10 @@ package body Prj.Env is
and then and then
(not Including_Libraries or else not Data.Library)) (not Including_Libraries or else not Data.Library))
then then
-- For a library project, add library ALI directory if -- For a library project, add the library ALI
-- there is no object directory or if the library ALI -- directory if there is no object directory or
-- directory contains ALI files, otherwise add the -- if the library ALI directory contains ALI files;
-- object directory. -- otherwise add the object directory.
if Data.Library then if Data.Library then
if Data.Object_Directory = No_Path if Data.Object_Directory = No_Path
...@@ -2131,21 +2295,17 @@ package body Prj.Env is ...@@ -2131,21 +2295,17 @@ package body Prj.Env is
end if; end if;
-- For a non-library project, add the object -- For a non-library project, add the object
-- directory, if it is not a virtual project, and -- directory, if it is not a virtual project, and if
-- if there are Ada sources or if the project is an -- there are Ada sources or if the project is an
-- extending project. if There Are No Ada sources, -- extending project. if There Are No Ada sources,
-- adding the object directory could disrupt -- adding the object directory could disrupt the order
-- the order of the object dirs in the path. -- of the object dirs in the path.
elsif not Data.Virtual elsif not Data.Virtual
and then (In_Tree.Projects.Table and then There_Are_Ada_Sources (In_Tree, Project)
(Project).Ada_Sources_Present
or else
(Data.Extends /= No_Project
and then
Data.Object_Directory /= No_Path))
then then
Add_To_Object_Path (Data.Object_Directory, In_Tree); Add_To_Object_Path
(Data.Object_Directory, In_Tree);
end if; end if;
end if; end if;
end if; end if;
...@@ -2347,21 +2507,21 @@ package body Prj.Env is ...@@ -2347,21 +2507,21 @@ package body Prj.Env is
----------------------- -----------------------
function Spec_Path_Name_Of function Spec_Path_Name_Of
(Unit : Unit_Id; In_Tree : Project_Tree_Ref) return String (Unit : Unit_Index; In_Tree : Project_Tree_Ref) return String
is is
Data : Unit_Data := In_Tree.Units.Table (Unit); Data : Unit_Data := In_Tree.Units.Table (Unit);
begin begin
if Data.File_Names (Specification).Path = No_File then if Data.File_Names (Specification).Path = No_Path then
declare declare
Current_Source : String_List_Id := Current_Source : String_List_Id :=
In_Tree.Projects.Table In_Tree.Projects.Table
(Data.File_Names (Specification).Project).Sources; (Data.File_Names (Specification).Project).Ada_Sources;
Path : GNAT.OS_Lib.String_Access; Path : GNAT.OS_Lib.String_Access;
begin begin
Data.File_Names (Specification).Path := Data.File_Names (Specification).Path :=
Data.File_Names (Specification).Name; Path_Name_Type (Data.File_Names (Specification).Name);
while Current_Source /= Nil_String loop while Current_Source /= Nil_String loop
Path := Locate_Regular_File Path := Locate_Regular_File
......
gcc/ada/prj-env.ads
...@@ -44,6 +44,16 @@ package Prj.Env is ...@@ -44,6 +44,16 @@ package Prj.Env is
-- in the closure of immediate sources of Project, put the mapping of -- in the closure of immediate sources of Project, put the mapping of
-- its spec and or body to its file name and path name in this file. -- its spec and or body to its file name and path name in this file.
procedure Create_Mapping_File
(Project : Project_Id;
Language : Name_Id;
Runtime : Project_Id;
In_Tree : Project_Tree_Ref;
Name : out Path_Name_Type);
-- Create a temporary mapping file for project Project. For each source or
-- template of Language in the of Project, put the mapping of its file
-- name and path name in this file.
procedure Set_Mapping_File_Initial_State_To_Empty; procedure Set_Mapping_File_Initial_State_To_Empty;
-- When creating a mapping file, create an empty map. This case occurs -- When creating a mapping file, create an empty map. This case occurs
-- when run time source files are found in the project files. -- when run time source files are found in the project files.
...@@ -61,6 +71,14 @@ package Prj.Env is ...@@ -61,6 +71,14 @@ package Prj.Env is
-- a temporary file that contains all configuration pragmas, and specify -- a temporary file that contains all configuration pragmas, and specify
-- the configuration pragmas file in the project data. -- the configuration pragmas file in the project data.
procedure Create_New_Path_File
(In_Tree : Project_Tree_Ref;
Path_FD : out File_Descriptor;
Path_Name : out Path_Name_Type);
-- Create a new temporary path file. Get the file name in Path_Name.
-- The name is normally obtained by increasing the number in
-- Temp_Path_File_Name by 1.
function Ada_Include_Path function Ada_Include_Path
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_Access; In_Tree : Project_Tree_Ref) return String_Access;
...@@ -135,7 +153,7 @@ package Prj.Env is ...@@ -135,7 +153,7 @@ package Prj.Env is
(Source_File_Name : String; (Source_File_Name : String;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Project : out Project_Id; Project : out Project_Id;
Path : out File_Name_Type); Path : out Path_Name_Type);
-- Returns the project of a source and its path in displayable form -- Returns the project of a source and its path in displayable form
generic generic
......
gcc/ada/prj-ext.adb
...@@ -29,14 +29,14 @@ with Makeutl; use Makeutl; ...@@ -29,14 +29,14 @@ with Makeutl; use Makeutl;
with Output; use Output; with Output; use Output;
with Osint; use Osint; with Osint; use Osint;
with Sdefault; with Sdefault;
with Table;
with GNAT.HTable; with GNAT.HTable;
package body Prj.Ext is package body Prj.Ext is
Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
Ada_Project_Path : constant String := "ADA_PROJECT_PATH"; Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
-- Name of the env. variables that contain path name(s) of directories -- Name of alternate env. variable that contain path name(s) of directories
-- where project files may reside. GPR_PROJECT_PATH has precedence over -- where project files may reside. GPR_PROJECT_PATH has precedence over
-- ADA_PROJECT_PATH. -- ADA_PROJECT_PATH.
...@@ -67,6 +67,7 @@ package body Prj.Ext is ...@@ -67,6 +67,7 @@ package body Prj.Ext is
-- first for external reference in this table, before checking the -- first for external reference in this table, before checking the
-- environment. Htable is emptied (reset) by procedure Reset. -- environment. Htable is emptied (reset) by procedure Reset.
---------
package Search_Directories is new Table.Table package Search_Directories is new Table.Table
(Table_Component_Type => Name_Id, (Table_Component_Type => Name_Id,
Table_Index_Type => Natural, Table_Index_Type => Natural,
...@@ -76,7 +77,6 @@ package body Prj.Ext is ...@@ -76,7 +77,6 @@ package body Prj.Ext is
Table_Name => "Prj.Ext.Search_Directories"); Table_Name => "Prj.Ext.Search_Directories");
-- The table for the directories specified with -aP switches -- The table for the directories specified with -aP switches
---------
-- Add -- -- Add --
--------- ---------
...@@ -97,6 +97,7 @@ package body Prj.Ext is ...@@ -97,6 +97,7 @@ package body Prj.Ext is
Htable.Set (The_Key, The_Value); Htable.Set (The_Key, The_Value);
end Add; end Add;
-----------
---------------------------------- ----------------------------------
-- Add_Search_Project_Directory -- -- Add_Search_Project_Directory --
---------------------------------- ----------------------------------
...@@ -108,7 +109,6 @@ package body Prj.Ext is ...@@ -108,7 +109,6 @@ package body Prj.Ext is
Search_Directories.Append (Name_Find); Search_Directories.Append (Name_Find);
end Add_Search_Project_Directory; end Add_Search_Project_Directory;
-----------
-- Check -- -- Check --
----------- -----------
...@@ -140,28 +140,22 @@ package body Prj.Ext is ...@@ -140,28 +140,22 @@ package body Prj.Ext is
Last : Positive; Last : Positive;
New_Len : Positive; New_Len : Positive;
New_Last : Positive; New_Last : Positive;
Prj_Path : String_Access := null; Prj_Path : String_Access := Gpr_Prj_Path;
begin begin
if Get_Mode = Ada_Only then
if Gpr_Prj_Path.all /= "" then if Gpr_Prj_Path.all /= "" then
if Hostparm.OpenVMS then
Prj_Path := To_Canonical_Path_Spec ("GPR_PROJECT_PATH:");
else
Prj_Path := To_Canonical_Path_Spec (Gpr_Prj_Path.all);
end if;
-- Warn if both environment variables are defined -- Warn if both environment variables are defined
if Ada_Prj_Path.all /= "" then if Ada_Prj_Path.all /= "" then
Write_Line ("Warning: ADA_PROJECT_PATH is not taken into account"); Write_Line
("Warning: ADA_PROJECT_PATH is not taken into account");
Write_Line (" when GPR_PROJECT_PATH is defined"); Write_Line (" when GPR_PROJECT_PATH is defined");
end if; end if;
elsif Ada_Prj_Path.all /= "" then
if Hostparm.OpenVMS then
Prj_Path := To_Canonical_Path_Spec ("ADA_PROJECT_PATH:");
else else
Prj_Path := To_Canonical_Path_Spec (Ada_Prj_Path.all); Prj_Path := Ada_Prj_Path;
end if; end if;
end if; end if;
...@@ -179,9 +173,9 @@ package body Prj.Ext is ...@@ -179,9 +173,9 @@ package body Prj.Ext is
(Get_Name_String (Search_Directories.Table (J))); (Get_Name_String (Search_Directories.Table (J)));
end loop; end loop;
-- If environment variable is defined, add its content -- If environment variable is defined and not empty, add its content
if Prj_Path /= null then if Prj_Path.all /= "" then
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Path_Separator; Name_Buffer (Name_Len) := Path_Separator;
...@@ -223,6 +217,11 @@ package body Prj.Ext is ...@@ -223,6 +217,11 @@ package body Prj.Ext is
Name_Len := Name_Len - No_Project_Default_Dir'Length - 1; Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
-- After removing the '-', go back one character to get the next
-- directory corectly.
Last := Last - 1;
elsif not Hostparm.OpenVMS elsif not Hostparm.OpenVMS
or else not Is_Absolute_Path (Name_Buffer (First .. Last)) or else not Is_Absolute_Path (Name_Buffer (First .. Last))
then then
...@@ -264,9 +263,19 @@ package body Prj.Ext is ...@@ -264,9 +263,19 @@ package body Prj.Ext is
Prefix := new String'(Executable_Prefix_Path); Prefix := new String'(Executable_Prefix_Path);
if Prefix.all /= "" then if Prefix.all /= "" then
if Get_Mode = Ada_Only then
Current_Project_Path := Current_Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator & new String'(Name_Buffer (1 .. Name_Len) &
Path_Separator &
Prefix.all & Directory_Separator & "gnat"); Prefix.all & Directory_Separator & "gnat");
else
Current_Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) &
Path_Separator &
Prefix.all & Directory_Separator &
"share" & Directory_Separator & "gpr");
end if;
end if; end if;
else else
...@@ -278,7 +287,9 @@ package body Prj.Ext is ...@@ -278,7 +287,9 @@ package body Prj.Ext is
".." & Directory_Separator & "gnat"); ".." & Directory_Separator & "gnat");
end if; end if;
end; end;
else end if;
if Current_Project_Path = null then
Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len)); Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len));
end if; end if;
end Initialize_Project_Path; end Initialize_Project_Path;
......
gcc/ada/prj-ext.ads
...@@ -29,6 +29,10 @@ ...@@ -29,6 +29,10 @@
package Prj.Ext is package Prj.Ext is
Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
-- Name of primary env. variable that contain path name(s) of directories
-- where project files may reside.
procedure Add_Search_Project_Directory (Path : String); procedure Add_Search_Project_Directory (Path : String);
-- Add a directory to the project path. Directories added with this -- Add a directory to the project path. Directories added with this
-- procedure are added in order after the current directory and before -- procedure are added in order after the current directory and before
......
gcc/ada/prj-nmsc.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/prj-nmsc.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -59,7 +59,7 @@ private package Prj.Nmsc is ...@@ -59,7 +59,7 @@ private package Prj.Nmsc is
-- still valid if they point to a file which is outside of the project), -- still valid if they point to a file which is outside of the project),
-- and that no directory has a name which is a valid source name. -- and that no directory has a name which is a valid source name.
-- --
-- When_No_Ada_Sources indicates what should be done when no Ada sources -- When_No_Sources indicates what should be done when no sources of a
-- are found in a project where Ada is a language. -- language are found in a project where this language is declared.
end Prj.Nmsc; end Prj.Nmsc;
gcc/ada/prj-pars.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,6 +32,7 @@ with Prj.Err; use Prj.Err; ...@@ -32,6 +32,7 @@ with Prj.Err; use Prj.Err;
with Prj.Part; with Prj.Part;
with Prj.Proc; with Prj.Proc;
with Prj.Tree; use Prj.Tree; with Prj.Tree; use Prj.Tree;
with Sinput.P;
package body Prj.Pars is package body Prj.Pars is
...@@ -44,7 +45,8 @@ package body Prj.Pars is ...@@ -44,7 +45,8 @@ package body Prj.Pars is
Project : out Project_Id; Project : out Project_Id;
Project_File_Name : String; Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
When_No_Sources : Error_Warning := Error) When_No_Sources : Error_Warning := Error;
Reset_Tree : Boolean := True)
is is
Project_Node_Tree : constant Project_Node_Tree_Ref := Project_Node_Tree : constant Project_Node_Tree_Ref :=
new Project_Node_Tree_Data; new Project_Node_Tree_Data;
...@@ -57,6 +59,7 @@ package body Prj.Pars is ...@@ -57,6 +59,7 @@ package body Prj.Pars is
-- Parse the main project file into a tree -- Parse the main project file into a tree
Sinput.P.Reset_First;
Prj.Part.Parse Prj.Part.Parse
(In_Tree => Project_Node_Tree, (In_Tree => Project_Node_Tree,
Project => Project_Node, Project => Project_Node,
...@@ -75,7 +78,8 @@ package body Prj.Pars is ...@@ -75,7 +78,8 @@ package body Prj.Pars is
From_Project_Node_Tree => Project_Node_Tree, From_Project_Node_Tree => Project_Node_Tree,
Report_Error => null, Report_Error => null,
Follow_Links => Opt.Follow_Links, Follow_Links => Opt.Follow_Links,
When_No_Sources => When_No_Sources); When_No_Sources => When_No_Sources,
Reset_Tree => Reset_Tree);
Prj.Err.Finalize; Prj.Err.Finalize;
if not Success then if not Success then
......
gcc/ada/prj-pars.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,7 +36,8 @@ package Prj.Pars is ...@@ -36,7 +36,8 @@ package Prj.Pars is
Project : out Project_Id; Project : out Project_Id;
Project_File_Name : String; Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
When_No_Sources : Error_Warning := Error); When_No_Sources : Error_Warning := Error;
Reset_Tree : Boolean := True);
-- Parse a project files and all its imported project files, in the -- Parse a project files and all its imported project files, in the
-- project tree In_Tree. -- project tree In_Tree.
-- --
...@@ -50,5 +51,8 @@ package Prj.Pars is ...@@ -50,5 +51,8 @@ package Prj.Pars is
-- --
-- When_No_Sources indicates what should be done when no sources -- When_No_Sources indicates what should be done when no sources
-- are found in a project for a specified or implied language. -- are found in a project for a specified or implied language.
--
-- When Reset_Tree is True, all the project data are removed from the
-- project table before processing.
end Prj.Pars; end Prj.Pars;
gcc/ada/prj-part.adb
...@@ -51,11 +51,6 @@ package body Prj.Part is ...@@ -51,11 +51,6 @@ package body Prj.Part is
Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
type Extension_Origin is (None, Extending_Simple, Extending_All);
-- Type of parameter From_Extended for procedures Parse_Single_Project and
-- Post_Parse_Context_Clause. Extending_All means that we are parsing the
-- tree rooted at an extending all project.
------------------------------------ ------------------------------------
-- Local Packages and Subprograms -- -- Local Packages and Subprograms --
------------------------------------ ------------------------------------
...@@ -64,7 +59,7 @@ package body Prj.Part is ...@@ -64,7 +59,7 @@ package body Prj.Part is
No_With : constant With_Id := 0; No_With : constant With_Id := 0;
type With_Record is record type With_Record is record
Path : File_Name_Type; Path : Path_Name_Type;
Location : Source_Ptr; Location : Source_Ptr;
Limited_With : Boolean; Limited_With : Boolean;
Node : Project_Node_Id; Node : Project_Node_Id;
...@@ -88,7 +83,6 @@ package body Prj.Part is ...@@ -88,7 +83,6 @@ package body Prj.Part is
Canonical_Path_Name : Path_Name_Type; Canonical_Path_Name : Path_Name_Type;
Id : Project_Node_Id; Id : Project_Node_Id;
end record; end record;
-- Needs a comment ???
package Project_Stack is new Table.Table package Project_Stack is new Table.Table
(Table_Component_Type => Names_And_Id, (Table_Component_Type => Names_And_Id,
...@@ -159,28 +153,13 @@ package body Prj.Part is ...@@ -159,28 +153,13 @@ package body Prj.Part is
Project_Directory : Path_Name_Type; Project_Directory : Path_Name_Type;
From_Extended : Extension_Origin; From_Extended : Extension_Origin;
In_Limited : Boolean; In_Limited : Boolean;
Packages_To_Check : String_List_Access); Packages_To_Check : String_List_Access;
Depth : Natural);
-- Parse the imported projects that have been stored in table Withs, -- Parse the imported projects that have been stored in table Withs,
-- if any. From_Extended is used for the call to Parse_Single_Project -- 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 -- below. When In_Limited is True, the importing path includes at least
-- one "limited with". -- one "limited with".
procedure Parse_Single_Project
(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
-- been parsed and is an extended project A, return the ultimate
-- (not extended) project that extends A. When In_Limited is True,
-- the importing path includes at least one "limited with".
function Project_Path_Name_Of function Project_Path_Name_Of
(Project_File_Name : String; (Project_File_Name : String;
Directory : String) return String; Directory : String) return String;
...@@ -193,7 +172,7 @@ package body Prj.Part is ...@@ -193,7 +172,7 @@ package body Prj.Part is
-- This includes the directory separator as the last character. -- This includes the directory separator as the last character.
-- Returns "./" if Path_Name contains no directory separator. -- Returns "./" if Path_Name contains no directory separator.
function Project_Name_From (Path_Name : String) return File_Name_Type; function Project_Name_From (Path_Name : String) return Name_Id;
-- Returns the name of the project that corresponds to its path name. -- Returns the name of the project that corresponds to its path name.
-- Returns No_Name if the path name is invalid, because the corresponding -- Returns No_Name if the path name is invalid, because the corresponding
-- project name does not have the syntax of an ada identifier. -- project name does not have the syntax of an ada identifier.
...@@ -349,7 +328,8 @@ package body Prj.Part is ...@@ -349,7 +328,8 @@ package body Prj.Part is
---------------------------- ----------------------------
function Immediate_Directory_Of function Immediate_Directory_Of
(Path_Name : Path_Name_Type) return Path_Name_Type (Path_Name : Path_Name_Type)
return Path_Name_Type
is is
begin begin
Get_Name_String (Path_Name); Get_Name_String (Path_Name);
...@@ -474,7 +454,7 @@ package body Prj.Part is ...@@ -474,7 +454,7 @@ package body Prj.Part is
Project := Empty_Node; Project := Empty_Node;
if Current_Verbosity >= Medium then if Current_Verbosity >= Medium then
Write_Str ("ADA_PROJECT_PATH="""); Write_Str ("GPR_PROJECT_PATH=""");
Write_Str (Project_Path); Write_Str (Project_Path);
Write_Line (""""); Write_Line ("""");
end if; end if;
...@@ -508,7 +488,8 @@ package body Prj.Part is ...@@ -508,7 +488,8 @@ package body Prj.Part is
Extended => False, Extended => False,
From_Extended => None, From_Extended => None,
In_Limited => False, In_Limited => False,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check,
Depth => 0);
-- If Project is an extending-all project, create the eventual -- If Project is an extending-all project, create the eventual
-- virtual extending projects and check that there are no illegally -- virtual extending projects and check that there are no illegally
...@@ -640,6 +621,13 @@ package body Prj.Part is ...@@ -640,6 +621,13 @@ package body Prj.Part is
Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree); Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
Limited_With := Token = Tok_Limited; Limited_With := Token = Tok_Limited;
if In_Configuration then
Error_Msg
("configuration project cannot import " &
"other configuration projects",
Token_Ptr);
end if;
if Limited_With then if Limited_With then
Scan (In_Tree); -- scan past LIMITED Scan (In_Tree); -- scan past LIMITED
Expect (Tok_With, "WITH"); Expect (Tok_With, "WITH");
...@@ -659,7 +647,7 @@ package body Prj.Part is ...@@ -659,7 +647,7 @@ package body Prj.Part is
-- Store path and location in table Withs -- Store path and location in table Withs
Current_With := Current_With :=
(Path => File_Name_Type (Token_Name), (Path => Path_Name_Type (Token_Name),
Location => Token_Ptr, Location => Token_Ptr,
Limited_With => Limited_With, Limited_With => Limited_With,
Node => Current_With_Node, Node => Current_With_Node,
...@@ -714,9 +702,10 @@ package body Prj.Part is ...@@ -714,9 +702,10 @@ package body Prj.Part is
Project_Directory : Path_Name_Type; Project_Directory : Path_Name_Type;
From_Extended : Extension_Origin; From_Extended : Extension_Origin;
In_Limited : Boolean; In_Limited : Boolean;
Packages_To_Check : String_List_Access) Packages_To_Check : String_List_Access;
Depth : Natural)
is is
Current_With_Clause : With_Id; Current_With_Clause : With_Id := Context_Clause;
Current_Project : Project_Node_Id := Empty_Node; Current_Project : Project_Node_Id := Empty_Node;
Previous_Project : Project_Node_Id := Empty_Node; Previous_Project : Project_Node_Id := Empty_Node;
...@@ -732,7 +721,6 @@ package body Prj.Part is ...@@ -732,7 +721,6 @@ package body Prj.Part is
begin begin
Imported_Projects := Empty_Node; Imported_Projects := Empty_Node;
Current_With_Clause := Context_Clause;
while Current_With_Clause /= No_With loop while Current_With_Clause /= No_With loop
Current_With := Withs.Table (Current_With_Clause); Current_With := Withs.Table (Current_With_Clause);
Current_With_Clause := Current_With.Next; Current_With_Clause := Current_With.Next;
...@@ -760,7 +748,8 @@ package body Prj.Part is ...@@ -760,7 +748,8 @@ package body Prj.Part is
-- The project file cannot be found -- The project file cannot be found
Error_Msg_File_1 := Current_With.Path; Error_Msg_File_1 := File_Name_Type (Current_With.Path);
Error_Msg ("unknown project file: {", Current_With.Location); Error_Msg ("unknown project file: {", Current_With.Location);
-- If this is not imported by the main project file, -- If this is not imported by the main project file,
...@@ -837,7 +826,8 @@ package body Prj.Part is ...@@ -837,7 +826,8 @@ package body Prj.Part is
Extended => False, Extended => False,
From_Extended => From_Extended, From_Extended => From_Extended,
In_Limited => Limited_With, In_Limited => Limited_With,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check,
Depth => Depth);
else else
Extends_All := Is_Extending_All (Withed_Project, In_Tree); Extends_All := Is_Extending_All (Withed_Project, In_Tree);
...@@ -895,7 +885,8 @@ package body Prj.Part is ...@@ -895,7 +885,8 @@ package body Prj.Part is
Extended : Boolean; Extended : Boolean;
From_Extended : Extension_Origin; From_Extended : Extension_Origin;
In_Limited : Boolean; In_Limited : Boolean;
Packages_To_Check : String_List_Access) Packages_To_Check : String_List_Access;
Depth : Natural)
is is
Normed_Path_Name : Path_Name_Type; Normed_Path_Name : Path_Name_Type;
Canonical_Path_Name : Path_Name_Type; Canonical_Path_Name : Path_Name_Type;
...@@ -911,8 +902,7 @@ package body Prj.Part is ...@@ -911,8 +902,7 @@ package body Prj.Part is
Tree_Private_Part.Projects_Htable.Get_First Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT); (In_Tree.Projects_HT);
Name_From_Path : constant File_Name_Type := Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
Project_Name_From (Path_Name);
Name_Of_Project : Name_Id := No_Name; Name_Of_Project : Name_Id := No_Name;
...@@ -949,21 +939,21 @@ package body Prj.Part is ...@@ -949,21 +939,21 @@ package body Prj.Part is
Project_Stack.Table (Index).Canonical_Path_Name Project_Stack.Table (Index).Canonical_Path_Name
then then
Error_Msg ("circular dependency detected", Token_Ptr); Error_Msg ("circular dependency detected", Token_Ptr);
Error_Msg_File_1 := File_Name_Type (Normed_Path_Name); Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
Error_Msg ("\\ { is imported by", Token_Ptr); Error_Msg ("\ %% is imported by", Token_Ptr);
for Current in reverse 1 .. Project_Stack.Last loop for Current in reverse 1 .. Project_Stack.Last loop
Error_Msg_File_1 := Error_Msg_Name_1 :=
File_Name_Type (Project_Stack.Table (Current).Path_Name); Name_Id (Project_Stack.Table (Current).Path_Name);
if Project_Stack.Table (Current).Canonical_Path_Name /= if Project_Stack.Table (Current).Canonical_Path_Name /=
Canonical_Path_Name Canonical_Path_Name
then then
Error_Msg Error_Msg
("\\ { which itself is imported by", Token_Ptr); ("\ %% which itself is imported by", Token_Ptr);
else else
Error_Msg ("\\ {", Token_Ptr); Error_Msg ("\ %%", Token_Ptr);
exit; exit;
end if; end if;
end loop; end loop;
...@@ -1060,15 +1050,23 @@ package body Prj.Part is ...@@ -1060,15 +1050,23 @@ package body Prj.Part is
Tree.Reset_State; Tree.Reset_State;
Scan (In_Tree); Scan (In_Tree);
if Name_From_Path = No_File then if (not In_Configuration) and then (Name_From_Path = No_Name) then
-- The project file name is not correct (no or bad extension, -- The project file name is not correct (no or bad extension,
-- or not following Ada identifier's syntax). -- or not following Ada identifier's syntax).
Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name); Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
if In_Configuration then
Error_Msg ("{ is not a valid path name for a configuration " &
"project file",
Token_Ptr);
else
Error_Msg ("?{ is not a valid path name for a project file", Error_Msg ("?{ is not a valid path name for a project file",
Token_Ptr); Token_Ptr);
end if; end if;
end if;
if Current_Verbosity >= Medium then if Current_Verbosity >= Medium then
Write_Str ("Parsing """); Write_Str ("Parsing """);
...@@ -1121,7 +1119,7 @@ package body Prj.Part is ...@@ -1121,7 +1119,7 @@ package body Prj.Part is
Scan (In_Tree); Scan (In_Tree);
-- If we have a dot, add a dot the the Buffer and look for the next -- If we have a dot, add a dot to the Buffer and look for the next
-- identifier. -- identifier.
exit when Token /= Tok_Dot; exit when Token /= Tok_Dot;
...@@ -1136,6 +1134,11 @@ package body Prj.Part is ...@@ -1136,6 +1134,11 @@ package body Prj.Part is
if Token = Tok_Extends then if Token = Tok_Extends then
if In_Configuration then
Error_Msg
("extending configuration project not allowed", Token_Ptr);
end if;
-- Make sure that gnatmake will use mapping files -- Make sure that gnatmake will use mapping files
Create_Mapping_File := True; Create_Mapping_File := True;
...@@ -1178,17 +1181,27 @@ package body Prj.Part is ...@@ -1178,17 +1181,27 @@ package body Prj.Part is
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
declare declare
Expected_Name : constant File_Name_Type := Name_Find; Expected_Name : constant Name_Id := Name_Find;
Extension : String_Access;
begin begin
-- Output a warning if the actual name is not the expected name -- Output a warning if the actual name is not the expected name
if Name_From_Path /= No_File if (not In_Configuration)
and then (Name_From_Path /= No_Name)
and then Expected_Name /= Name_From_Path and then Expected_Name /= Name_From_Path
then then
Error_Msg_File_1 := Expected_Name; Error_Msg_Name_1 := Expected_Name;
Error_Msg ("?file name does not match unit name, " &
"should be `{" & Project_File_Extension & "`", if In_Configuration then
Extension := new String'(Config_Project_File_Extension);
else
Extension := new String'(Project_File_Extension);
end if;
Error_Msg ("?file name does not match project name, " &
"should be `%%" & Extension.all & "`",
Token_Ptr); Token_Ptr);
end if; end if;
end; end;
...@@ -1217,7 +1230,8 @@ package body Prj.Part is ...@@ -1217,7 +1230,8 @@ package body Prj.Part is
Project_Directory => Project_Directory, Project_Directory => Project_Directory,
From_Extended => From_Ext, From_Extended => From_Ext,
In_Limited => In_Limited, In_Limited => In_Limited,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check,
Depth => Depth + 1);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end; end;
...@@ -1225,7 +1239,6 @@ package body Prj.Part is ...@@ -1225,7 +1239,6 @@ package body Prj.Part is
Name_And_Node : Tree_Private_Part.Project_Name_And_Node := 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); (In_Tree.Projects_HT);
Project_Name : Name_Id := Name_And_Node.Name; Project_Name : Name_Id := Name_And_Node.Name;
begin begin
...@@ -1246,10 +1259,10 @@ package body Prj.Part is ...@@ -1246,10 +1259,10 @@ package body Prj.Part is
Error_Msg_Name_1 := Project_Name; Error_Msg_Name_1 := Project_Name;
Error_Msg Error_Msg
("duplicate project name %%", Location_Of (Project, In_Tree)); ("duplicate project name %%", Location_Of (Project, In_Tree));
Error_Msg_File_1 := Error_Msg_Name_1 :=
File_Name_Type (Path_Name_Of (Name_And_Node.Node, In_Tree)); Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
Error_Msg Error_Msg
("\already in {", Location_Of (Project, In_Tree)); ("\already in %%", Location_Of (Project, In_Tree));
else else
-- Otherwise, add the name of the project to the hash table, so -- Otherwise, add the name of the project to the hash table, so
...@@ -1273,7 +1286,9 @@ package body Prj.Part is ...@@ -1273,7 +1286,9 @@ package body Prj.Part is
if Token = Tok_String_Literal then if Token = Tok_String_Literal then
Set_Extended_Project_Path_Of Set_Extended_Project_Path_Of
(Project, In_Tree, Path_Name_Type (Token_Name)); (Project,
In_Tree,
Path_Name_Type (Token_Name));
declare declare
Original_Path_Name : constant String := Original_Path_Name : constant String :=
...@@ -1290,23 +1305,24 @@ package body Prj.Part is ...@@ -1290,23 +1305,24 @@ package body Prj.Part is
-- We could not find the project file to extend -- We could not find the project file to extend
Error_Msg_File_1 := File_Name_Type (Token_Name); Error_Msg_Name_1 := Token_Name;
Error_Msg ("unknown project file: {", Token_Ptr);
Error_Msg ("unknown project file: %%", Token_Ptr);
-- If we are not in the main project file, display the -- If we are not in the main project file, display the
-- import path. -- import path.
if Project_Stack.Last > 1 then if Project_Stack.Last > 1 then
Error_Msg_File_1 := Error_Msg_Name_1 :=
File_Name_Type Name_Id
(Project_Stack.Table (Project_Stack.Last).Path_Name); (Project_Stack.Table (Project_Stack.Last).Path_Name);
Error_Msg ("\extended by {", Token_Ptr); Error_Msg ("\extended by %%", Token_Ptr);
for Index in reverse 1 .. Project_Stack.Last - 1 loop for Index in reverse 1 .. Project_Stack.Last - 1 loop
Error_Msg_File_1 := Error_Msg_Name_1 :=
File_Name_Type Name_Id
(Project_Stack.Table (Index).Path_Name); (Project_Stack.Table (Index).Path_Name);
Error_Msg ("\imported by {", Token_Ptr); Error_Msg ("\imported by %%", Token_Ptr);
end loop; end loop;
end if; end if;
...@@ -1327,7 +1343,8 @@ package body Prj.Part is ...@@ -1327,7 +1343,8 @@ package body Prj.Part is
Extended => True, Extended => True,
From_Extended => From_Ext, From_Extended => From_Ext,
In_Limited => In_Limited, In_Limited => In_Limited,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check,
Depth => Depth + 1);
end; end;
-- A project that extends an extending-all project is also -- A project that extends an extending-all project is also
...@@ -1360,9 +1377,8 @@ package body Prj.Part is ...@@ -1360,9 +1377,8 @@ package body Prj.Part is
Imported := Project_Node_Of (With_Clause, In_Tree); Imported := Project_Node_Of (With_Clause, In_Tree);
if Is_Extending_All (With_Clause, In_Tree) then if Is_Extending_All (With_Clause, In_Tree) then
Error_Msg_File_1 := Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
File_Name_Type (Name_Of (Imported, In_Tree)); Error_Msg ("cannot import extending-all project %%",
Error_Msg ("cannot import extending-all project {",
Token_Ptr); Token_Ptr);
exit With_Clause_Loop; exit With_Clause_Loop;
end if; end if;
...@@ -1395,7 +1411,7 @@ package body Prj.Part is ...@@ -1395,7 +1411,7 @@ package body Prj.Part is
Name_Len := Name_Len - 1; Name_Len := Name_Len - 1;
declare declare
Parent_Name : constant File_Name_Type := Name_Find; Parent_Name : constant Name_Id := Name_Find;
Parent_Found : Boolean := False; Parent_Found : Boolean := False;
With_Clause : Project_Node_Id := With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project, In_Tree); First_With_Clause_Of (Project, In_Tree);
...@@ -1405,7 +1421,7 @@ package body Prj.Part is ...@@ -1405,7 +1421,7 @@ package body Prj.Part is
if Extended_Project /= Empty_Node then if Extended_Project /= Empty_Node then
Parent_Found := Parent_Found :=
Name_Of (Extended_Project, In_Tree) = Name_Id (Parent_Name); Name_Of (Extended_Project, In_Tree) = Parent_Name;
end if; end if;
-- If the parent project is not the extended project, -- If the parent project is not the extended project,
...@@ -1414,7 +1430,7 @@ package body Prj.Part is ...@@ -1414,7 +1430,7 @@ package body Prj.Part is
while not Parent_Found and then With_Clause /= Empty_Node loop while not Parent_Found and then With_Clause /= Empty_Node loop
Parent_Found := Parent_Found :=
Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) = Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) =
Name_Id (Parent_Name); Parent_Name;
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop; end loop;
...@@ -1422,8 +1438,8 @@ package body Prj.Part is ...@@ -1422,8 +1438,8 @@ package body Prj.Part is
if not Parent_Found then if not Parent_Found then
Error_Msg_Name_1 := Name_Of_Project; Error_Msg_Name_1 := Name_Of_Project;
Error_Msg_File_1 := Parent_Name; Error_Msg_Name_2 := Parent_Name;
Error_Msg ("project %% does not import or extend project {", Error_Msg ("project %% does not import or extend project %%",
Location_Of (Project, In_Tree)); Location_Of (Project, In_Tree));
end if; end if;
end; end;
...@@ -1547,7 +1563,7 @@ package body Prj.Part is ...@@ -1547,7 +1563,7 @@ package body Prj.Part is
-- Project_Name_From -- -- Project_Name_From --
----------------------- -----------------------
function Project_Name_From (Path_Name : String) return File_Name_Type is function Project_Name_From (Path_Name : String) return Name_Id is
Canonical : String (1 .. Path_Name'Length) := Path_Name; Canonical : String (1 .. Path_Name'Length) := Path_Name;
First : Natural := Canonical'Last; First : Natural := Canonical'Last;
Last : Natural := First; Last : Natural := First;
...@@ -1563,7 +1579,7 @@ package body Prj.Part is ...@@ -1563,7 +1579,7 @@ package body Prj.Part is
-- If the path name is empty, return No_Name to indicate failure -- If the path name is empty, return No_Name to indicate failure
if First = 0 then if First = 0 then
return No_File; return No_Name;
end if; end if;
Canonical_Case_File_Name (Canonical); Canonical_Case_File_Name (Canonical);
...@@ -1580,8 +1596,13 @@ package body Prj.Part is ...@@ -1580,8 +1596,13 @@ package body Prj.Part is
-- If we have a dot, check that it is followed by the correct extension -- If we have a dot, check that it is followed by the correct extension
if First > 0 and then Canonical (First) = '.' then if First > 0 and then Canonical (First) = '.' then
if Canonical (First .. Last) = Project_File_Extension if ((not In_Configuration) and then
and then First /= 1 Canonical (First .. Last) = Project_File_Extension and then
First /= 1)
or else
(In_Configuration and then
Canonical (First .. Last) = Config_Project_File_Extension and then
First /= 1)
then then
-- Look for the last directory separator, if any -- Look for the last directory separator, if any
...@@ -1598,13 +1619,13 @@ package body Prj.Part is ...@@ -1598,13 +1619,13 @@ package body Prj.Part is
else else
-- Not the correct extension, return No_Name to indicate failure -- Not the correct extension, return No_Name to indicate failure
return No_File; return No_Name;
end if; end if;
-- If no dot in the path name, return No_Name to indicate failure -- If no dot in the path name, return No_Name to indicate failure
else else
return No_File; return No_Name;
end if; end if;
First := First + 1; First := First + 1;
...@@ -1612,7 +1633,7 @@ package body Prj.Part is ...@@ -1612,7 +1633,7 @@ package body Prj.Part is
-- If the extension is the file name, return No_Name to indicate failure -- If the extension is the file name, return No_Name to indicate failure
if First > Last then if First > Last then
return No_File; return No_Name;
end if; end if;
-- Put the name in lower case into Name_Buffer -- Put the name in lower case into Name_Buffer
...@@ -1627,7 +1648,7 @@ package body Prj.Part is ...@@ -1627,7 +1648,7 @@ package body Prj.Part is
loop loop
if not Is_Letter (Name_Buffer (Index)) then if not Is_Letter (Name_Buffer (Index)) then
return No_File; return No_Name;
else else
loop loop
...@@ -1637,7 +1658,7 @@ package body Prj.Part is ...@@ -1637,7 +1658,7 @@ package body Prj.Part is
if Name_Buffer (Index) = '_' then if Name_Buffer (Index) = '_' then
if Name_Buffer (Index + 1) = '_' then if Name_Buffer (Index + 1) = '_' then
return No_File; return No_Name;
end if; end if;
end if; end if;
...@@ -1646,7 +1667,7 @@ package body Prj.Part is ...@@ -1646,7 +1667,7 @@ package body Prj.Part is
if Name_Buffer (Index) /= '_' if Name_Buffer (Index) /= '_'
and then not Is_Alphanumeric (Name_Buffer (Index)) and then not Is_Alphanumeric (Name_Buffer (Index))
then then
return No_File; return No_Name;
end if; end if;
end loop; end loop;
...@@ -1660,7 +1681,7 @@ package body Prj.Part is ...@@ -1660,7 +1681,7 @@ package body Prj.Part is
return Name_Find; return Name_Find;
else else
return No_File; return No_Name;
end if; end if;
elsif Name_Buffer (Index) = '-' then elsif Name_Buffer (Index) = '-' then
......
gcc/ada/prj-part.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -46,4 +46,27 @@ package Prj.Part is ...@@ -46,4 +46,27 @@ package Prj.Part is
-- unknown attribute produces a warning. When Store_Comments is True, -- unknown attribute produces a warning. When Store_Comments is True,
-- comments are stored in the parse tree. -- comments are stored in the parse tree.
type Extension_Origin is (None, Extending_Simple, Extending_All);
-- Type of parameter From_Extended for procedures Parse_Single_Project and
-- Post_Parse_Context_Clause. Extending_All means that we are parsing the
-- tree rooted at an extending all project.
procedure Parse_Single_Project
(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;
Depth : Natural);
-- 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
-- been parsed and is an extended project A, return the ultimate
-- (not extended) project that extends A. When In_Limited is True,
-- the importing path includes at least one "limited with".
-- When parsing configuration projects, do not allow a depth > 1.
end Prj.Part; end Prj.Part;
gcc/ada/prj-proc.adb
...@@ -32,6 +32,7 @@ with Prj.Attr; use Prj.Attr; ...@@ -32,6 +32,7 @@ with Prj.Attr; use Prj.Attr;
with Prj.Err; use Prj.Err; with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext; with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc; with Prj.Nmsc; use Prj.Nmsc;
with Prj.Util; use Prj.Util;
with Sinput; use Sinput; with Sinput; use Sinput;
with Snames; with Snames;
...@@ -51,21 +52,32 @@ package body Prj.Proc is ...@@ -51,21 +52,32 @@ package body Prj.Proc is
Equal => "="); Equal => "=");
-- This hash table contains all processed projects -- This hash table contains all processed projects
package Unit_Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Source_Id,
No_Element => No_Source,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- This hash table contains all processed projects
procedure Add (To_Exp : in out Name_Id; Str : Name_Id); procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
-- Concatenate two strings and returns another string if both -- Concatenate two strings and returns another string if both
-- arguments are not null string. -- arguments are not null string.
procedure Add_Attributes procedure Add_Attributes
(Project : Project_Id; (Project : Project_Id;
Project_Name : Name_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Decl : in out Declarations; Decl : in out Declarations;
First : Attribute_Node_Id); First : Attribute_Node_Id;
Project_Level : Boolean);
-- Add all attributes, starting with First, with their default -- Add all attributes, starting with First, with their default
-- values to the package or project with declarations Decl. -- values to the package or project with declarations Decl.
procedure Check procedure Check
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : in out Project_Id; Project : Project_Id;
Follow_Links : Boolean; Follow_Links : Boolean;
When_No_Sources : Error_Warning); When_No_Sources : Error_Warning);
-- Set all projects to not checked, then call Recursive_Check for the -- Set all projects to not checked, then call Recursive_Check for the
...@@ -167,9 +179,11 @@ package body Prj.Proc is ...@@ -167,9 +179,11 @@ package body Prj.Proc is
procedure Add_Attributes procedure Add_Attributes
(Project : Project_Id; (Project : Project_Id;
Project_Name : Name_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Decl : in out Declarations; Decl : in out Declarations;
First : Attribute_Node_Id) First : Attribute_Node_Id;
Project_Level : Boolean)
is is
The_Attribute : Attribute_Node_Id := First; The_Attribute : Attribute_Node_Id := First;
...@@ -200,6 +214,15 @@ package body Prj.Proc is ...@@ -200,6 +214,15 @@ package body Prj.Proc is
Value => Empty_String, Value => Empty_String,
Index => 0); Index => 0);
-- Special case of <project>'Name
if Project_Level
and then Attribute_Name_Of (The_Attribute) =
Snames.Name_Name
then
New_Attribute.Value := Project_Name;
end if;
-- List attributes have a default value of nil list -- List attributes have a default value of nil list
when List => when List =>
...@@ -235,7 +258,7 @@ package body Prj.Proc is ...@@ -235,7 +258,7 @@ package body Prj.Proc is
procedure Check procedure Check
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : in out Project_Id; Project : Project_Id;
Follow_Links : Boolean; Follow_Links : Boolean;
When_No_Sources : Error_Warning) When_No_Sources : Error_Warning)
is is
...@@ -248,7 +271,39 @@ package body Prj.Proc is ...@@ -248,7 +271,39 @@ package body Prj.Proc is
In_Tree.Projects.Table (Index).Checked := False; In_Tree.Projects.Table (Index).Checked := False;
end loop; end loop;
Recursive_Check (Project, In_Tree, Follow_Links, When_No_Sources); Recursive_Check
(Project, In_Tree, Follow_Links, When_No_Sources);
-- Set the Other_Part field for the units
declare
Source1 : Source_Id;
Name : Name_Id;
Source2 : Source_Id;
begin
Unit_Htable.Reset;
Source1 := In_Tree.First_Source;
while Source1 /= No_Source loop
Name := In_Tree.Sources.Table (Source1).Unit;
if Name /= No_Name then
Source2 := Unit_Htable.Get (Name);
if Source2 = No_Source then
Unit_Htable.Set (K => Name, E => Source1);
else
Unit_Htable.Remove (Name);
In_Tree.Sources.Table (Source1).Other_Part := Source2;
In_Tree.Sources.Table (Source2).Other_Part := Source1;
end if;
end if;
Source1 := In_Tree.Sources.Table (Source1).Next_In_Sources;
end loop;
end;
end Check; end Check;
------------------------------- -------------------------------
...@@ -590,7 +645,6 @@ package body Prj.Proc is ...@@ -590,7 +645,6 @@ package body Prj.Proc is
The_Name := The_Name :=
Name_Of (Term_Project, From_Project_Node_Tree); Name_Of (Term_Project, From_Project_Node_Tree);
The_Project := Imported_Or_Extended_Project_From The_Project := Imported_Or_Extended_Project_From
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
...@@ -603,7 +657,6 @@ package body Prj.Proc is ...@@ -603,7 +657,6 @@ package body Prj.Proc is
The_Name := The_Name :=
Name_Of (Term_Package, From_Project_Node_Tree); Name_Of (Term_Package, From_Project_Node_Tree);
The_Package := In_Tree.Projects.Table The_Package := In_Tree.Projects.Table
(The_Project).Decl.Packages; (The_Project).Decl.Packages;
...@@ -1140,23 +1193,307 @@ package body Prj.Proc is ...@@ -1140,23 +1193,307 @@ package body Prj.Proc is
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Report_Error : Put_Line_Access;
Follow_Links : Boolean := True; Follow_Links : Boolean := True;
When_No_Sources : Error_Warning := Error) When_No_Sources : Error_Warning := Error;
Reset_Tree : Boolean := True)
is is
Obj_Dir : Path_Name_Type; Obj_Dir : Path_Name_Type;
Extending : Project_Id; Extending : Project_Id;
Extending2 : Project_Id; Extending2 : Project_Id;
Packages : Package_Id;
Element : Package_Element;
procedure Process_Attributes (Attrs : Variable_Id);
------------------------
-- Process_Attributes --
------------------------
procedure Process_Attributes (Attrs : Variable_Id) is
Attribute_Id : Variable_Id;
Attribute : Variable;
List : String_List_Id;
begin
-- Loop through attributes
Attribute_Id := Attrs;
while Attribute_Id /= No_Variable loop
Attribute :=
In_Tree.Variable_Elements.Table (Attribute_Id);
if not Attribute.Value.Default then
case Attribute.Name is
when Snames.Name_Driver =>
-- Attribute Linker'Driver: the default linker to use
In_Tree.Config.Linker :=
Path_Name_Type (Attribute.Value.Value);
when Snames.Name_Required_Switches =>
-- Attribute Linker'Required_Switches: the minimum
-- options to use when invoking the linker
Put (Into_List =>
In_Tree.Config.Minimum_Linker_Options,
From_List => Attribute.Value.Values,
In_Tree => In_Tree);
when Snames.Name_Executable_Suffix =>
-- Attribute Executable_Suffix: the suffix of the
-- executables.
In_Tree.Config.Executable_Suffix :=
Attribute.Value.Value;
when Snames.Name_Library_Builder =>
-- Attribute Library_Builder: the application to invoke
-- to build libraries.
In_Tree.Config.Library_Builder :=
Path_Name_Type (Attribute.Value.Value);
when Snames.Name_Archive_Builder =>
-- Attribute Archive_Builder: the archive builder
-- (usually "ar") and its minimum options (usually "cr").
List := Attribute.Value.Values;
if List = Nil_String then
Error_Msg
("archive builder cannot be null",
Attribute.Value.Location);
end if;
Put (Into_List => In_Tree.Config.Archive_Builder,
From_List => List,
In_Tree => In_Tree);
when Snames.Name_Archive_Indexer =>
-- Attribute Archive_Indexer: the optional archive
-- indexer (usually "ranlib") with its minimum options
-- (usually none).
List := Attribute.Value.Values;
if List = Nil_String then
Error_Msg
("archive indexer cannot be null",
Attribute.Value.Location);
end if;
Put (Into_List => In_Tree.Config.Archive_Indexer,
From_List => List,
In_Tree => In_Tree);
when Snames.Name_Library_Partial_Linker =>
-- Attribute Library_Partial_Linker: the optional linker
-- driver with its minimum options, to partially link
-- archives.
List := Attribute.Value.Values;
if List = Nil_String then
Error_Msg
("partial linker cannot be null",
Attribute.Value.Location);
end if;
Put (Into_List => In_Tree.Config.Lib_Partial_Linker,
From_List => List,
In_Tree => In_Tree);
when Snames.Name_Archive_Suffix =>
In_Tree.Config.Archive_Suffix :=
File_Name_Type (Attribute.Value.Value);
when Snames.Name_Linker_Executable_Option =>
-- Attribute Linker_Executable_Option: optional options
-- to specify an executable name. Defaults to "-o".
List := Attribute.Value.Values;
if List = Nil_String then
Error_Msg
("linker executable option cannot be null",
Attribute.Value.Location);
end if;
Put (Into_List =>
In_Tree.Config.Linker_Executable_Option,
From_List => List,
In_Tree => In_Tree);
when Snames.Name_Linker_Lib_Dir_Option =>
-- Attribute Linker_Lib_Dir_Option: optional options
-- to specify a library search directory. Defaults to
-- "-L".
Get_Name_String (Attribute.Value.Value);
if Name_Len = 0 then
Error_Msg
("linker library directory option cannot be empty",
Attribute.Value.Location);
end if;
In_Tree.Config.Linker_Lib_Dir_Option :=
Attribute.Value.Value;
when Snames.Name_Linker_Lib_Name_Option =>
-- Attribute Linker_Lib_Name_Option: optional options
-- to specify the name of a library to be linked in.
-- Defaults to "-l".
Get_Name_String (Attribute.Value.Value);
if Name_Len = 0 then
Error_Msg
("linker library name option cannot be empty",
Attribute.Value.Location);
end if;
In_Tree.Config.Linker_Lib_Name_Option :=
Attribute.Value.Value;
when Snames.Name_Run_Path_Option =>
-- Attribute Run_Path_Option: optional options to
-- specify a path for libraries.
List := Attribute.Value.Values;
if List /= Nil_String then
Put (Into_List => In_Tree.Config.Run_Path_Option,
From_List => List,
In_Tree => In_Tree);
end if;
when Snames.Name_Library_Support =>
declare
pragma Unsuppress (All_Checks);
begin
In_Tree.Config.Lib_Support :=
Library_Support'Value (Get_Name_String
(Attribute.Value.Value));
exception
when Constraint_Error =>
Error_Msg
("invalid value """ &
Get_Name_String (Attribute.Value.Value) &
""" for Library_Support",
Attribute.Value.Location);
end;
when Snames.Name_Shared_Library_Prefix =>
In_Tree.Config.Shared_Lib_Prefix :=
File_Name_Type (Attribute.Value.Value);
when Snames.Name_Shared_Library_Suffix =>
In_Tree.Config.Shared_Lib_Suffix :=
File_Name_Type (Attribute.Value.Value);
when Snames.Name_Symbolic_Link_Supported =>
declare
pragma Unsuppress (All_Checks);
begin
In_Tree.Config.Symbolic_Link_Supported :=
Boolean'Value (Get_Name_String
(Attribute.Value.Value));
exception
when Constraint_Error =>
Error_Msg
("invalid value """ &
Get_Name_String (Attribute.Value.Value) &
""" for Symbolic_Link_Supported",
Attribute.Value.Location);
end;
when Snames.Name_Library_Major_Minor_Id_Supported =>
declare
pragma Unsuppress (All_Checks);
begin
In_Tree.Config.Lib_Maj_Min_Id_Supported :=
Boolean'Value (Get_Name_String
(Attribute.Value.Value));
exception
when Constraint_Error =>
Error_Msg
("invalid value """ &
Get_Name_String (Attribute.Value.Value) &
""" for Library_Major_Minor_Id_Supported",
Attribute.Value.Location);
end;
when Snames.Name_Library_Auto_Init_Supported =>
declare
pragma Unsuppress (All_Checks);
begin
In_Tree.Config.Auto_Init_Supported :=
Boolean'Value (Get_Name_String
(Attribute.Value.Value));
exception
when Constraint_Error =>
Error_Msg
("invalid value """ &
Get_Name_String (Attribute.Value.Value) &
""" for Library_Auto_Init_Supported",
Attribute.Value.Location);
end;
when Snames.Name_Shared_Library_Minimum_Switches =>
List := Attribute.Value.Values;
if List /= Nil_String then
Put (Into_List =>
In_Tree.Config.Shared_Lib_Min_Options,
From_List => List,
In_Tree => In_Tree);
end if;
when Snames.Name_Library_Version_Switches =>
List := Attribute.Value.Values;
if List /= Nil_String then
Put (Into_List =>
In_Tree.Config.Lib_Version_Options,
From_List => List,
In_Tree => In_Tree);
end if;
when others =>
null;
end case;
end if;
Attribute_Id := Attribute.Next;
end loop;
end Process_Attributes;
begin begin
Error_Report := Report_Error; Error_Report := Report_Error;
Success := True; Success := True;
-- Make sure there is no projects in the data structure if Reset_Tree then
-- Make sure there are no projects in the data structure
Project_Table.Set_Last (In_Tree.Projects, No_Project); Project_Table.Set_Last (In_Tree.Projects, No_Project);
end if;
Processed_Projects.Reset; Processed_Projects.Reset;
-- And process the main project and all of the projects it depends on, -- And process the main project and all of the projects it depends on,
-- recursively -- recursively.
Recursive_Process Recursive_Process
(Project => Project, (Project => Project,
...@@ -1165,20 +1502,25 @@ package body Prj.Proc is ...@@ -1165,20 +1502,25 @@ package body Prj.Proc is
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => No_Project); Extended_By => No_Project);
if not In_Configuration then
if Project /= No_Project then if Project /= No_Project then
Check (In_Tree, Project, Follow_Links, When_No_Sources); Check
(In_Tree, Project, Follow_Links, When_No_Sources);
end if; end if;
-- If main project is an extending all project, set the object -- If main project is an extending all project, set the object
-- directory of all virtual extending projects to the object directory -- directory of all virtual extending projects to the object
-- of the main project. -- directory of the main project.
if Project /= No_Project if Project /= No_Project
and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree) and then
Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
then then
declare declare
Object_Dir : constant Path_Name_Type := Object_Dir : constant Path_Name_Type :=
In_Tree.Projects.Table (Project).Object_Directory; In_Tree.Projects.Table
(Project).Object_Directory;
begin begin
for Index in for Index in
Project_Table.First .. Project_Table.Last (In_Tree.Projects) Project_Table.First .. Project_Table.Last (In_Tree.Projects)
...@@ -1204,14 +1546,16 @@ package body Prj.Proc is ...@@ -1204,14 +1546,16 @@ package body Prj.Proc is
Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory; Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory;
-- Check that a project being extended does not share its -- Check that a project being extended does not share its
-- object directory with any project that extends it, directly -- object directory with any project that extends it,
-- or indirectly, including a virtual extending project. -- directly or indirectly, including a virtual extending
-- project.
-- Start with the project directly extending it -- Start with the project directly extending it
Extending2 := Extending; Extending2 := Extending;
while Extending2 /= No_Project loop while Extending2 /= No_Project loop
if In_Tree.Projects.Table (Extending2).Ada_Sources_Present if In_Tree.Projects.Table (Extending2).Ada_Sources /=
Nil_String
and then and then
In_Tree.Projects.Table (Extending2).Object_Directory = In_Tree.Projects.Table (Extending2).Object_Directory =
Obj_Dir Obj_Dir
...@@ -1222,8 +1566,8 @@ package body Prj.Proc is ...@@ -1222,8 +1566,8 @@ package body Prj.Proc is
if Error_Report = null then if Error_Report = null then
Error_Msg Error_Msg
("project % cannot be extended by a virtual " & ("project %% cannot be extended by a virtual" &
"project with the same object directory", " project with the same object directory",
In_Tree.Projects.Table (Proj).Location); In_Tree.Projects.Table (Proj).Location);
else else
Error_Report Error_Report
...@@ -1271,6 +1615,41 @@ package body Prj.Proc is ...@@ -1271,6 +1615,41 @@ package body Prj.Proc is
end loop; end loop;
end if; end if;
-- Get the global configuration
if Project /= No_Project then
Process_Attributes
(In_Tree.Projects.Table (Project).Decl.Attributes);
-- Loop through packages ???
Packages := In_Tree.Projects.Table (Project).Decl.Packages;
while Packages /= No_Package loop
Element := In_Tree.Packages.Table (Packages);
case Element.Name is
when Snames.Name_Builder =>
-- Process attributes of package Builder
Process_Attributes (Element.Decl.Attributes);
when Snames.Name_Linker =>
-- Process attributes of package Linker
Process_Attributes (Element.Decl.Attributes);
when others =>
null;
end case;
Packages := Element.Next;
end loop;
end if;
end if;
Success := Success :=
Total_Errors_Detected = 0 Total_Errors_Detected = 0
and then and then
...@@ -1289,12 +1668,15 @@ package body Prj.Proc is ...@@ -1289,12 +1668,15 @@ package body Prj.Proc is
Pkg : Package_Id; Pkg : Package_Id;
Item : Project_Node_Id) Item : Project_Node_Id)
is is
Current_Declarative_Item : Project_Node_Id := Item; Current_Declarative_Item : Project_Node_Id;
Current_Item : Project_Node_Id := Empty_Node; Current_Item : Project_Node_Id;
begin begin
-- For each declarative item -- Loop through declarative items
Current_Item := Empty_Node;
Current_Declarative_Item := Item;
while Current_Declarative_Item /= Empty_Node loop while Current_Declarative_Item /= Empty_Node loop
-- Get its data -- Get its data
...@@ -1313,6 +1695,7 @@ package body Prj.Proc is ...@@ -1313,6 +1695,7 @@ package body Prj.Proc is
case Kind_Of (Current_Item, From_Project_Node_Tree) is case Kind_Of (Current_Item, From_Project_Node_Tree) is
when N_Package_Declaration => when N_Package_Declaration =>
-- Do not process a package declaration that should be ignored -- Do not process a package declaration that should be ignored
if Expression_Kind_Of if Expression_Kind_Of
...@@ -1400,11 +1783,14 @@ package body Prj.Proc is ...@@ -1400,11 +1783,14 @@ package body Prj.Proc is
-- Set the default values of the attributes -- Set the default values of the attributes
Add_Attributes Add_Attributes
(Project, In_Tree, (Project,
In_Tree.Projects.Table (Project).Name,
In_Tree,
In_Tree.Packages.Table (New_Pkg).Decl, In_Tree.Packages.Table (New_Pkg).Decl,
First_Attribute_Of First_Attribute_Of
(Package_Id_Of (Package_Id_Of
(Current_Item, From_Project_Node_Tree))); (Current_Item, From_Project_Node_Tree)),
Project_Level => False);
-- And process declarative items of the new package -- And process declarative items of the new package
...@@ -1745,7 +2131,7 @@ package body Prj.Proc is ...@@ -1745,7 +2131,7 @@ package body Prj.Proc is
if Error_Report = null then if Error_Report = null then
Error_Msg Error_Msg
("no value defined for %", ("no value defined for %%",
Location_Of Location_Of
(Current_Item, From_Project_Node_Tree)); (Current_Item, From_Project_Node_Tree));
...@@ -1791,8 +2177,8 @@ package body Prj.Proc is ...@@ -1791,8 +2177,8 @@ package body Prj.Proc is
if Error_Report = null then if Error_Report = null then
Error_Msg Error_Msg
("value %% is illegal for " ("value %% is illegal " &
& "typed string %", "for typed string %%",
Location_Of Location_Of
(Current_Item, (Current_Item,
From_Project_Node_Tree)); From_Project_Node_Tree));
...@@ -1805,10 +2191,6 @@ package body Prj.Proc is ...@@ -1805,10 +2191,6 @@ package body Prj.Proc is
Get_Name_String (Error_Msg_Name_2) & Get_Name_String (Error_Msg_Name_2) &
"""", """",
Project, In_Tree); Project, In_Tree);
-- Calls like this to Error_Report are
-- wrong, since they don't properly case
-- and decode names corresponding to the
-- ordinary case of % insertion ???
end if; end if;
end if; end if;
end; end;
...@@ -2414,8 +2796,7 @@ package body Prj.Proc is ...@@ -2414,8 +2796,7 @@ package body Prj.Proc is
Location_Of (From_Project_Node, From_Project_Node_Tree); Location_Of (From_Project_Node, From_Project_Node_Tree);
Processed_Data.Display_Directory := Processed_Data.Display_Directory :=
Path_Name_Type Directory_Of (From_Project_Node, From_Project_Node_Tree);
(Directory_Of (From_Project_Node, From_Project_Node_Tree));
Get_Name_String (Processed_Data.Display_Directory); Get_Name_String (Processed_Data.Display_Directory);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Processed_Data.Directory := Name_Find; Processed_Data.Directory := Name_Find;
...@@ -2423,10 +2804,15 @@ package body Prj.Proc is ...@@ -2423,10 +2804,15 @@ package body Prj.Proc is
Processed_Data.Extended_By := Extended_By; Processed_Data.Extended_By := Extended_By;
Add_Attributes Add_Attributes
(Project, In_Tree, Processed_Data.Decl, Attribute_First); (Project,
Name,
In_Tree,
Processed_Data.Decl,
Prj.Attr.Attribute_First,
Project_Level => True);
With_Clause := With_Clause :=
First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree); First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree);
while With_Clause /= Empty_Node loop while With_Clause /= Empty_Node loop
declare declare
New_Project : Project_Id; New_Project : Project_Id;
......
gcc/ada/prj-proc.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -40,7 +40,8 @@ package Prj.Proc is ...@@ -40,7 +40,8 @@ package Prj.Proc is
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Report_Error : Put_Line_Access;
Follow_Links : Boolean := True; Follow_Links : Boolean := True;
When_No_Sources : Error_Warning := Error); When_No_Sources : Error_Warning := Error;
Reset_Tree : Boolean := True);
-- Process a project file tree into project file data structures. If -- Process a project file tree into project file data structures. If
-- Report_Error is null, use the error reporting mechanism. Otherwise, -- Report_Error is null, use the error reporting mechanism. Otherwise,
-- report errors using Report_Error. -- report errors using Report_Error.
...@@ -53,6 +54,9 @@ package Prj.Proc is ...@@ -53,6 +54,9 @@ package Prj.Proc is
-- When_No_Sources indicates what should be done when no sources -- When_No_Sources indicates what should be done when no sources
-- are found in a project for a specified or implied language. -- are found in a project for a specified or implied language.
-- --
-- When Reset_Tree is True, all the project data are removed from the
-- project table before processing.
--
-- Process is a bit of a junk name, how about Process_Project_Tree??? -- Process is a bit of a junk name, how about Process_Project_Tree???
end Prj.Proc; end Prj.Proc;
gcc/ada/prj-strt.adb
...@@ -45,6 +45,7 @@ package body Prj.Strt is ...@@ -45,6 +45,7 @@ package body Prj.Strt is
Choices_Initial : constant := 10; Choices_Initial : constant := 10;
Choices_Increment : constant := 100; Choices_Increment : constant := 100;
-- These should be in alloc.ads
Choice_Node_Low_Bound : constant := 0; Choice_Node_Low_Bound : constant := 0;
Choice_Node_High_Bound : constant := 099_999_999; Choice_Node_High_Bound : constant := 099_999_999;
...@@ -211,8 +212,9 @@ package body Prj.Strt is ...@@ -211,8 +212,9 @@ package body Prj.Strt is
(Reference, In_Tree, To => Variable_Kind_Of (Current_Attribute)); (Reference, In_Tree, To => Variable_Kind_Of (Current_Attribute));
Set_Case_Insensitive Set_Case_Insensitive
(Reference, In_Tree, (Reference, In_Tree,
To => Attribute_Kind_Of (Current_Attribute) = To => Attribute_Kind_Of (Current_Attribute) in
Case_Insensitive_Associative_Array); Case_Insensitive_Associative_Array ..
Optional_Index_Case_Insensitive_Associative_Array);
-- Scan past the attribute name -- Scan past the attribute name
...@@ -321,7 +323,8 @@ package body Prj.Strt is ...@@ -321,7 +323,8 @@ package body Prj.Strt is
Choice_First := 0; Choice_First := 0;
elsif Choice_Lasts.Last = 2 then elsif Choice_Lasts.Last = 2 then
-- This is the second case onstruction, set the tables to the first
-- This is the second case construction, set the tables to the first
Choice_Lasts.Set_Last (1); Choice_Lasts.Set_Last (1);
Choices.Set_Last (Choice_Lasts.Table (1)); Choices.Set_Last (Choice_Lasts.Table (1));
...@@ -390,15 +393,10 @@ package body Prj.Strt is ...@@ -390,15 +393,10 @@ package body Prj.Strt is
case Token is case Token is
when Tok_Right_Paren => when Tok_Right_Paren =>
Scan (In_Tree); -- scan past right paren
-- Scan past the right parenthesis
Scan (In_Tree);
when Tok_Comma => when Tok_Comma =>
Scan (In_Tree); -- scan past comma
-- Scan past the comma
Scan (In_Tree);
-- Get the string expression for the default -- Get the string expression for the default
...@@ -423,10 +421,8 @@ package body Prj.Strt is ...@@ -423,10 +421,8 @@ package body Prj.Strt is
Expect (Tok_Right_Paren, "`)`"); Expect (Tok_Right_Paren, "`)`");
-- Scan past the right parenthesis
if Token = Tok_Right_Paren then if Token = Tok_Right_Paren then
Scan (In_Tree); Scan (In_Tree); -- scan past right paren
end if; end if;
when others => when others =>
...@@ -477,16 +473,19 @@ package body Prj.Strt is ...@@ -477,16 +473,19 @@ package body Prj.Strt is
Found := False; Found := False;
for Choice in Choice_First .. Choices.Last loop for Choice in Choice_First .. Choices.Last loop
if Choices.Table (Choice).The_String = Choice_String then if Choices.Table (Choice).The_String = Choice_String then
-- This label is part of the string type -- This label is part of the string type
Found := True; Found := True;
if Choices.Table (Choice).Already_Used then if Choices.Table (Choice).Already_Used then
-- But it has already appeared in a choice list for this -- But it has already appeared in a choice list for this
-- case construction; report an error. -- case construction so report an error.
Error_Msg_Name_1 := Choice_String; Error_Msg_Name_1 := Choice_String;
Error_Msg ("duplicate case label %%", Token_Ptr); Error_Msg ("duplicate case label %%", Token_Ptr);
else else
Choices.Table (Choice).Already_Used := True; Choices.Table (Choice).Already_Used := True;
end if; end if;
...@@ -509,6 +508,7 @@ package body Prj.Strt is ...@@ -509,6 +508,7 @@ package body Prj.Strt is
-- If there is no '|', we are done -- If there is no '|', we are done
if Token = Tok_Vertical_Bar then if Token = Tok_Vertical_Bar then
-- Otherwise, declare the node of the next choice, link it to -- Otherwise, declare the node of the next choice, link it to
-- Current_Choice and set Current_Choice to this new node. -- Current_Choice and set Current_Choice to this new node.
...@@ -606,6 +606,7 @@ package body Prj.Strt is ...@@ -606,6 +606,7 @@ package body Prj.Strt is
begin begin
while Current /= Last_String loop while Current /= Last_String loop
if String_Value_Of (Current, In_Tree) = String_Value then if String_Value_Of (Current, In_Tree) = String_Value then
-- This is a repetition, report an error -- This is a repetition, report an error
Error_Msg_Name_1 := String_Value; Error_Msg_Name_1 := String_Value;
...@@ -705,12 +706,21 @@ package body Prj.Strt is ...@@ -705,12 +706,21 @@ package body Prj.Strt is
-- Now, look if it can be a project name -- Now, look if it can be a project name
The_Project := Imported_Or_Extended_Project_Of if Names.Table (1).Name =
Name_Of (Current_Project, In_Tree)
then
The_Project := Current_Project;
else
The_Project :=
Imported_Or_Extended_Project_Of
(Current_Project, In_Tree, Names.Table (1).Name); (Current_Project, In_Tree, Names.Table (1).Name);
end if;
if The_Project = Empty_Node then if The_Project = Empty_Node then
-- If it is neither a project name nor a package name, -- If it is neither a project name nor a package name,
-- report an error -- report an error.
if First_Attribute = Empty_Attribute then if First_Attribute = Empty_Attribute then
Error_Msg_Name_1 := Names.Table (1).Name; Error_Msg_Name_1 := Names.Table (1).Name;
...@@ -719,8 +729,8 @@ package body Prj.Strt is ...@@ -719,8 +729,8 @@ package body Prj.Strt is
First_Attribute := Attribute_First; First_Attribute := Attribute_First;
else else
-- If it is a package name, check if the package -- If it is a package name, check if the package has
-- has already been declared in the current project. -- already been declared in the current project.
The_Package := The_Package :=
First_Package_Of (Current_Project, In_Tree); First_Package_Of (Current_Project, In_Tree);
...@@ -797,8 +807,16 @@ package body Prj.Strt is ...@@ -797,8 +807,16 @@ package body Prj.Strt is
-- Check if the long project is imported or extended -- Check if the long project is imported or extended
The_Project := Imported_Or_Extended_Project_Of if Long_Project = Name_Of (Current_Project, In_Tree) then
(Current_Project, In_Tree, Long_Project); The_Project := Current_Project;
else
The_Project :=
Imported_Or_Extended_Project_Of
(Current_Project,
In_Tree,
Long_Project);
end if;
-- If the long project exists, then this is the prefix -- If the long project exists, then this is the prefix
-- of the attribute. -- of the attribute.
...@@ -811,12 +829,18 @@ package body Prj.Strt is ...@@ -811,12 +829,18 @@ package body Prj.Strt is
-- Otherwise, check if the short project is imported -- Otherwise, check if the short project is imported
-- or extended. -- or extended.
if Short_Project =
Name_Of (Current_Project, In_Tree)
then
The_Project := Current_Project;
else
The_Project := Imported_Or_Extended_Project_Of The_Project := Imported_Or_Extended_Project_Of
(Current_Project, In_Tree, (Current_Project, In_Tree,
Short_Project); Short_Project);
end if;
-- If the short project does not exist, we report an -- If short project does not exist, report an error
-- error.
if The_Project = Empty_Node then if The_Project = Empty_Node then
Error_Msg_Name_1 := Long_Project; Error_Msg_Name_1 := Long_Project;
...@@ -881,7 +905,7 @@ package body Prj.Strt is ...@@ -881,7 +905,7 @@ package body Prj.Strt is
case Names.Last is case Names.Last is
when 0 => when 0 =>
-- Cannot happen -- Cannot happen (so why null instead of raise PE???)
null; null;
...@@ -990,7 +1014,8 @@ package body Prj.Strt is ...@@ -990,7 +1014,8 @@ package body Prj.Strt is
-- First check for a possible project name -- First check for a possible project name
The_Project := Imported_Or_Extended_Project_Of The_Project :=
Imported_Or_Extended_Project_Of
(Current_Project, In_Tree, Short_Project); (Current_Project, In_Tree, Short_Project);
if The_Project = Empty_Node then if The_Project = Empty_Node then
...@@ -998,7 +1023,8 @@ package body Prj.Strt is ...@@ -998,7 +1023,8 @@ package body Prj.Strt is
Error_Msg_Name_1 := Long_Project; Error_Msg_Name_1 := Long_Project;
Error_Msg_Name_2 := Short_Project; Error_Msg_Name_2 := Short_Project;
Error_Msg ("unknown projects % or %", Error_Msg
("unknown projects % or %",
Names.Table (1).Location); Names.Table (1).Location);
Look_For_Variable := False; Look_For_Variable := False;
...@@ -1018,7 +1044,8 @@ package body Prj.Strt is ...@@ -1018,7 +1044,8 @@ package body Prj.Strt is
end loop; end loop;
if The_Package = Empty_Node then if The_Package = Empty_Node then
-- The package does not vexist, report an error
-- The package does not exist, report an error
Error_Msg_Name_1 := Names.Table (2).Name; Error_Msg_Name_1 := Names.Table (2).Name;
Error_Msg ("unknown package %", Error_Msg ("unknown package %",
...@@ -1041,7 +1068,6 @@ package body Prj.Strt is ...@@ -1041,7 +1068,6 @@ package body Prj.Strt is
if Specified_Project /= Empty_Node then if Specified_Project /= Empty_Node then
The_Project := Specified_Project; The_Project := Specified_Project;
else else
The_Project := Current_Project; The_Project := Current_Project;
end if; end if;
...@@ -1056,7 +1082,6 @@ package body Prj.Strt is ...@@ -1056,7 +1082,6 @@ package body Prj.Strt is
if Specified_Package /= Empty_Node then if Specified_Package /= Empty_Node then
Current_Variable := Current_Variable :=
First_Variable_Of (Specified_Package, In_Tree); First_Variable_Of (Specified_Package, In_Tree);
while Current_Variable /= Empty_Node while Current_Variable /= Empty_Node
and then and then
Name_Of (Current_Variable, In_Tree) /= Variable_Name Name_Of (Current_Variable, In_Tree) /= Variable_Name
...@@ -1074,7 +1099,6 @@ package body Prj.Strt is ...@@ -1074,7 +1099,6 @@ package body Prj.Strt is
then then
Current_Variable := Current_Variable :=
First_Variable_Of (Current_Package, In_Tree); First_Variable_Of (Current_Package, In_Tree);
while Current_Variable /= Empty_Node while Current_Variable /= Empty_Node
and then Name_Of (Current_Variable, In_Tree) /= Variable_Name and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop loop
...@@ -1088,7 +1112,6 @@ package body Prj.Strt is ...@@ -1088,7 +1112,6 @@ package body Prj.Strt is
if Current_Variable = Empty_Node then if Current_Variable = Empty_Node then
Current_Variable := First_Variable_Of (The_Project, In_Tree); Current_Variable := First_Variable_Of (The_Project, In_Tree);
while Current_Variable /= Empty_Node while Current_Variable /= Empty_Node
and then Name_Of (Current_Variable, In_Tree) /= Variable_Name and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop loop
...@@ -1112,8 +1135,8 @@ package body Prj.Strt is ...@@ -1112,8 +1135,8 @@ package body Prj.Strt is
(Variable, In_Tree, (Variable, In_Tree,
To => Expression_Kind_Of (Current_Variable, In_Tree)); To => Expression_Kind_Of (Current_Variable, In_Tree));
if if Kind_Of (Current_Variable, In_Tree) =
Kind_Of (Current_Variable, In_Tree) = N_Typed_Variable_Declaration N_Typed_Variable_Declaration
then then
Set_String_Type_Of Set_String_Type_Of
(Variable, In_Tree, (Variable, In_Tree,
...@@ -1151,7 +1174,7 @@ package body Prj.Strt is ...@@ -1151,7 +1174,7 @@ package body Prj.Strt is
Current_String : Project_Node_Id; Current_String : Project_Node_Id;
begin begin
-- Set Choice_First, depending on whether is the first case -- Set Choice_First, depending on whether this is the first case
-- construction or not. -- construction or not.
if Choice_First = 0 then if Choice_First = 0 then
...@@ -1161,11 +1184,10 @@ package body Prj.Strt is ...@@ -1161,11 +1184,10 @@ package body Prj.Strt is
Choice_First := Choices.Last + 1; Choice_First := Choices.Last + 1;
end if; end if;
-- Add to table Choices the literal of the string type -- Add the literal of the string type to the Choices table
if String_Type /= Empty_Node then if String_Type /= Empty_Node then
Current_String := First_Literal_String (String_Type, In_Tree); Current_String := First_Literal_String (String_Type, In_Tree);
while Current_String /= Empty_Node loop while Current_String /= Empty_Node loop
Add (This_String => String_Value_Of (Current_String, In_Tree)); Add (This_String => String_Value_Of (Current_String, In_Tree));
Current_String := Next_Literal_String (Current_String, In_Tree); Current_String := Next_Literal_String (Current_String, In_Tree);
...@@ -1176,7 +1198,6 @@ package body Prj.Strt is ...@@ -1176,7 +1198,6 @@ package body Prj.Strt is
Choice_Lasts.Increment_Last; Choice_Lasts.Increment_Last;
Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last; Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last;
end Start_New_Case_Construction; end Start_New_Case_Construction;
----------- -----------
...@@ -1249,8 +1270,7 @@ package body Prj.Strt is ...@@ -1249,8 +1270,7 @@ package body Prj.Strt is
Scan (In_Tree); Scan (In_Tree);
else else
-- Otherwise, we parse the expression(s) in the literal string -- Otherwise parse the expression(s) in the literal string list
-- list.
loop loop
Current_Location := Token_Ptr; Current_Location := Token_Ptr;
...@@ -1387,7 +1407,7 @@ package body Prj.Strt is ...@@ -1387,7 +1407,7 @@ package body Prj.Strt is
when Tok_Project => when Tok_Project =>
-- project can appear in an expression as the prefix of an -- Project can appear in an expression as the prefix of an
-- attribute reference of the current project. -- attribute reference of the current project.
Current_Location := Token_Ptr; Current_Location := Token_Ptr;
...@@ -1420,6 +1440,7 @@ package body Prj.Strt is ...@@ -1420,6 +1440,7 @@ package body Prj.Strt is
end if; end if;
when Tok_External => when Tok_External =>
-- An external reference is always a single string -- An external reference is always a single string
if Expr_Kind = Undefined then if Expr_Kind = Undefined then
...@@ -1442,10 +1463,7 @@ package body Prj.Strt is ...@@ -1442,10 +1463,7 @@ package body Prj.Strt is
-- If there is an '&', call Terms recursively -- If there is an '&', call Terms recursively
if Token = Tok_Ampersand then if Token = Tok_Ampersand then
Scan (In_Tree); -- scan past ampersand
-- Scan past the '&'
Scan (In_Tree);
Terms Terms
(In_Tree => In_Tree, (In_Tree => In_Tree,
......
gcc/ada/prj-tree.ads
...@@ -29,6 +29,8 @@ ...@@ -29,6 +29,8 @@
with GNAT.Dynamic_HTables; with GNAT.Dynamic_HTables;
with GNAT.Dynamic_Tables; with GNAT.Dynamic_Tables;
with Table;
with Prj.Attr; use Prj.Attr; with Prj.Attr; use Prj.Attr;
package Prj.Tree is package Prj.Tree is
...@@ -196,8 +198,11 @@ package Prj.Tree is ...@@ -196,8 +198,11 @@ package Prj.Tree is
-- The following query functions are part of the abstract interface -- The following query functions are part of the abstract interface
-- of the Project File tree. They provide access to fields of a project. -- of the Project File tree. They provide access to fields of a project.
-- In the following, there are "valid if" comments, but no indication -- The access functions should be called only with valid arguments.
-- of what happens if they are called with invalid arguments ??? -- For each function the condition of validity is specified. If an access
-- function is called with invalid arguments, then exception
-- Assertion_Error is raised if assertions are enabled, otherwise the
-- behaviour is not defined and may result in a crash.
function Name_Of function Name_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
...@@ -1206,7 +1211,8 @@ package Prj.Tree is ...@@ -1206,7 +1211,8 @@ package Prj.Tree is
-- Node of the project in table Project_Nodes -- Node of the project in table Project_Nodes
Canonical_Path : Path_Name_Type; Canonical_Path : Path_Name_Type;
-- Resolved and canonical path of the project file -- Resolved and canonical path of a real project file.
-- No_Name in case of virtual projects.
Extended : Boolean; Extended : Boolean;
-- True when the project is being extended by another project -- True when the project is being extended by another project
......
gcc/ada/prj-util.adb
...@@ -26,7 +26,7 @@ ...@@ -26,7 +26,7 @@
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with System.Case_Util; use System.Case_Util; with GNAT.Case_Util; use GNAT.Case_Util;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
...@@ -56,6 +56,38 @@ package body Prj.Util is ...@@ -56,6 +56,38 @@ package body Prj.Util is
Free (File); Free (File);
end Close; end Close;
---------------
-- Duplicate --
---------------
procedure Duplicate
(This : in out Name_List_Index;
In_Tree : Project_Tree_Ref)
is
Old_Current : Name_List_Index;
New_Current : Name_List_Index;
begin
if This /= No_Name_List then
Old_Current := This;
Name_List_Table.Increment_Last (In_Tree.Name_Lists);
New_Current := Name_List_Table.Last (In_Tree.Name_Lists);
This := New_Current;
In_Tree.Name_Lists.Table (New_Current) :=
(In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List);
loop
Old_Current := In_Tree.Name_Lists.Table (Old_Current).Next;
exit when Old_Current = No_Name_List;
In_Tree.Name_Lists.Table (New_Current).Next := New_Current + 1;
Name_List_Table.Increment_Last (In_Tree.Name_Lists);
New_Current := New_Current + 1;
In_Tree.Name_Lists.Table (New_Current) :=
(In_Tree.Name_Lists.Table (Old_Current).Name, No_Name_List);
end loop;
end if;
end Duplicate;
----------------- -----------------
-- End_Of_File -- -- End_Of_File --
----------------- -----------------
...@@ -101,24 +133,35 @@ package body Prj.Util is ...@@ -101,24 +133,35 @@ package body Prj.Util is
Executable_Suffix : Variable_Value := Nil_Variable_Value; Executable_Suffix : Variable_Value := Nil_Variable_Value;
Body_Append : constant String := Get_Name_String Executable_Suffix_Name : Name_Id := No_Name;
(In_Tree.Projects.Table
(Project).
Naming.Ada_Body_Suffix);
Spec_Append : constant String := Get_Name_String Naming : constant Naming_Data := In_Tree.Projects.Table (Project).Naming;
(In_Tree.Projects.Table
(Project). Body_Suffix : constant String :=
Naming.Ada_Spec_Suffix); Body_Suffix_Of (In_Tree, "ada", Naming);
Spec_Suffix : constant String :=
Spec_Suffix_Of (In_Tree, "ada", Naming);
begin begin
if Builder_Package /= No_Package then if Builder_Package /= No_Package then
if Get_Mode = Multi_Language then
Executable_Suffix_Name := In_Tree.Config.Executable_Suffix;
else
Executable_Suffix := Prj.Util.Value_Of Executable_Suffix := Prj.Util.Value_Of
(Variable_Name => Name_Executable_Suffix, (Variable_Name => Name_Executable_Suffix,
In_Variables => In_Tree.Packages.Table In_Variables => In_Tree.Packages.Table
(Builder_Package).Decl.Attributes, (Builder_Package).Decl.Attributes,
In_Tree => In_Tree); In_Tree => In_Tree);
if Executable_Suffix /= Nil_Variable_Value
and then not Executable_Suffix.Default
then
Executable_Suffix_Name := Executable_Suffix.Value;
end if;
end if;
if Executable = Nil_Variable_Value and Ada_Main then if Executable = Nil_Variable_Value and Ada_Main then
Get_Name_String (Main); Get_Name_String (Main);
...@@ -130,14 +173,6 @@ package body Prj.Util is ...@@ -130,14 +173,6 @@ package body Prj.Util is
Name_Buffer (1 .. Name_Len); Name_Buffer (1 .. Name_Len);
Last : Positive := Name_Len; Last : Positive := Name_Len;
Naming : constant Naming_Data :=
In_Tree.Projects.Table (Project).Naming;
Spec_Suffix : constant String :=
Get_Name_String (Naming.Ada_Spec_Suffix);
Body_Suffix : constant String :=
Get_Name_String (Naming.Ada_Body_Suffix);
Truncated : Boolean := False; Truncated : Boolean := False;
begin begin
...@@ -186,10 +221,8 @@ package body Prj.Util is ...@@ -186,10 +221,8 @@ package body Prj.Util is
Result : File_Name_Type; Result : File_Name_Type;
begin begin
if Executable_Suffix /= Nil_Variable_Value if Executable_Suffix_Name /= No_Name then
and then not Executable_Suffix.Default Executable_Extension_On_Target := Executable_Suffix_Name;
then
Executable_Extension_On_Target := Executable_Suffix.Value;
end if; end if;
Result := Executable_Name (File_Name_Type (Executable.Value)); Result := Executable_Name (File_Name_Type (Executable.Value));
...@@ -205,21 +238,21 @@ package body Prj.Util is ...@@ -205,21 +238,21 @@ package body Prj.Util is
-- otherwise remove any suffix ('.' followed by other characters), if -- otherwise remove any suffix ('.' followed by other characters), if
-- there is one. -- there is one.
if Ada_Main and then Name_Len > Body_Append'Length if Ada_Main and then Name_Len > Body_Suffix'Length
and then Name_Buffer (Name_Len - Body_Append'Length + 1 .. Name_Len) = and then Name_Buffer (Name_Len - Body_Suffix'Length + 1 .. Name_Len) =
Body_Append Body_Suffix
then then
-- Found the body termination, remove it -- Found the body termination, remove it
Name_Len := Name_Len - Body_Append'Length; Name_Len := Name_Len - Body_Suffix'Length;
elsif Ada_Main and then Name_Len > Spec_Append'Length elsif Ada_Main and then Name_Len > Spec_Suffix'Length
and then Name_Buffer (Name_Len - Spec_Append'Length + 1 .. Name_Len) = and then Name_Buffer (Name_Len - Spec_Suffix'Length + 1 .. Name_Len) =
Spec_Append Spec_Suffix
then then
-- Found the spec termination, remove it -- Found the spec termination, remove it
Name_Len := Name_Len - Spec_Append'Length; Name_Len := Name_Len - Spec_Suffix'Length;
else else
-- Remove any suffix, if there is one -- Remove any suffix, if there is one
...@@ -242,9 +275,20 @@ package body Prj.Util is ...@@ -242,9 +275,20 @@ package body Prj.Util is
end; end;
else else
-- Otherwise, add the standard suffix for the platform, if any -- Get the executable name. If Executable_Suffix is defined in the
-- configuration, make sure that it will be the extension of the
-- executable.
declare
Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
Result : File_Name_Type;
return Executable_Name (Name_Find); begin
Executable_Extension_On_Target := In_Tree.Config.Executable_Suffix;
Result := Executable_Name (Name_Find);
Executable_Extension_On_Target := Saved_EEOT;
return Result;
end;
end if; end if;
end Executable_Of; end Executable_Of;
...@@ -348,8 +392,10 @@ package body Prj.Util is ...@@ -348,8 +392,10 @@ package body Prj.Util is
File_Name (File_Name'Last) := ASCII.NUL; File_Name (File_Name'Last) := ASCII.NUL;
FD := Open_Read (Name => File_Name'Address, FD := Open_Read (Name => File_Name'Address,
Fmode => GNAT.OS_Lib.Text); Fmode => GNAT.OS_Lib.Text);
if FD = Invalid_FD then if FD = Invalid_FD then
File := null; File := null;
else else
File := new Text_File_Data; File := new Text_File_Data;
File.FD := FD; File.FD := FD;
...@@ -366,6 +412,52 @@ package body Prj.Util is ...@@ -366,6 +412,52 @@ package body Prj.Util is
end if; end if;
end Open; end Open;
---------
-- Put --
---------
procedure Put
(Into_List : in out Name_List_Index;
From_List : String_List_Id;
In_Tree : Project_Tree_Ref)
is
Current_Name : Name_List_Index;
List : String_List_Id;
Element : String_Element;
Last : Name_List_Index :=
Name_List_Table.Last (In_Tree.Name_Lists);
begin
Current_Name := Into_List;
while Current_Name /= No_Name_List and then
In_Tree.Name_Lists.Table (Current_Name).Next /= No_Name_List
loop
Current_Name := In_Tree.Name_Lists.Table (Current_Name).Next;
end loop;
List := From_List;
while List /= Nil_String loop
Element := In_Tree.String_Elements.Table (List);
Name_List_Table.Append
(In_Tree.Name_Lists,
(Name => Element.Value, Next => No_Name_List));
Last := Last + 1;
if Current_Name = No_Name_List then
Into_List := Last;
else
In_Tree.Name_Lists.Table (Current_Name).Next := Last;
end if;
Current_Name := Last;
List := Element.Next;
end loop;
end Put;
-------------- --------------
-- Value_Of -- -- Value_Of --
-------------- --------------
...@@ -390,11 +482,13 @@ package body Prj.Util is ...@@ -390,11 +482,13 @@ package body Prj.Util is
In_Array : Array_Element_Id; In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Name_Id In_Tree : Project_Tree_Ref) return Name_Id
is is
Current : Array_Element_Id := In_Array; Current : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
Real_Index : Name_Id := Index; Real_Index : Name_Id := Index;
begin begin
Current := In_Array;
if Current = No_Array_Element then if Current = No_Array_Element then
return No_Name; return No_Name;
end if; end if;
...@@ -426,20 +520,25 @@ package body Prj.Util is ...@@ -426,20 +520,25 @@ package body Prj.Util is
(Index : Name_Id; (Index : Name_Id;
Src_Index : Int := 0; Src_Index : Int := 0;
In_Array : Array_Element_Id; In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Variable_Value In_Tree : Project_Tree_Ref;
Force_Lower_Case_Index : Boolean := False) return Variable_Value
is is
Current : Array_Element_Id := In_Array; Current : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
Real_Index : Name_Id := Index; Real_Index : Name_Id;
begin begin
Current := In_Array;
if Current = No_Array_Element then if Current = No_Array_Element then
return Nil_Variable_Value; return Nil_Variable_Value;
end if; end if;
Element := In_Tree.Array_Elements.Table (Current); Element := In_Tree.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then Real_Index := Index;
if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
Get_Name_String (Index); Get_Name_String (Index);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Real_Index := Name_Find; Real_Index := Name_Find;
...@@ -465,7 +564,8 @@ package body Prj.Util is ...@@ -465,7 +564,8 @@ package body Prj.Util is
Index : Int := 0; Index : Int := 0;
Attribute_Or_Array_Name : Name_Id; Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id; In_Package : Package_Id;
In_Tree : Project_Tree_Ref) return Variable_Value In_Tree : Project_Tree_Ref;
Force_Lower_Case_Index : Boolean := False) return Variable_Value
is is
The_Array : Array_Element_Id; The_Array : Array_Element_Id;
The_Attribute : Variable_Value := Nil_Variable_Value; The_Attribute : Variable_Value := Nil_Variable_Value;
...@@ -485,7 +585,8 @@ package body Prj.Util is ...@@ -485,7 +585,8 @@ package body Prj.Util is
(Index => Name, (Index => Name,
Src_Index => Index, Src_Index => Index,
In_Array => The_Array, In_Array => The_Array,
In_Tree => In_Tree); In_Tree => In_Tree,
Force_Lower_Case_Index => Force_Lower_Case_Index);
-- If there is no array element, look for a variable -- If there is no array element, look for a variable
...@@ -508,10 +609,11 @@ package body Prj.Util is ...@@ -508,10 +609,11 @@ package body Prj.Util is
In_Arrays : Array_Id; In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Name_Id In_Tree : Project_Tree_Ref) return Name_Id
is is
Current : Array_Id := In_Arrays; Current : Array_Id;
The_Array : Array_Data; The_Array : Array_Data;
begin begin
Current := In_Arrays;
while Current /= No_Array loop while Current /= No_Array loop
The_Array := In_Tree.Arrays.Table (Current); The_Array := In_Tree.Arrays.Table (Current);
if The_Array.Name = In_Array then if The_Array.Name = In_Array then
...@@ -530,10 +632,11 @@ package body Prj.Util is ...@@ -530,10 +632,11 @@ package body Prj.Util is
In_Arrays : Array_Id; In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Array_Element_Id In_Tree : Project_Tree_Ref) return Array_Element_Id
is is
Current : Array_Id := In_Arrays; Current : Array_Id;
The_Array : Array_Data; The_Array : Array_Data;
begin begin
Current := In_Arrays;
while Current /= No_Array loop while Current /= No_Array loop
The_Array := In_Tree.Arrays.Table (Current); The_Array := In_Tree.Arrays.Table (Current);
...@@ -552,10 +655,11 @@ package body Prj.Util is ...@@ -552,10 +655,11 @@ package body Prj.Util is
In_Packages : Package_Id; In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id In_Tree : Project_Tree_Ref) return Package_Id
is is
Current : Package_Id := In_Packages; Current : Package_Id;
The_Package : Package_Element; The_Package : Package_Element;
begin begin
Current := In_Packages;
while Current /= No_Package loop while Current /= No_Package loop
The_Package := In_Tree.Packages.Table (Current); The_Package := In_Tree.Packages.Table (Current);
exit when The_Package.Name /= No_Name exit when The_Package.Name /= No_Name
...@@ -571,10 +675,11 @@ package body Prj.Util is ...@@ -571,10 +675,11 @@ package body Prj.Util is
In_Variables : Variable_Id; In_Variables : Variable_Id;
In_Tree : Project_Tree_Ref) return Variable_Value In_Tree : Project_Tree_Ref) return Variable_Value
is is
Current : Variable_Id := In_Variables; Current : Variable_Id;
The_Variable : Variable; The_Variable : Variable;
begin begin
Current := In_Variables;
while Current /= No_Variable loop while Current /= No_Variable loop
The_Variable := The_Variable :=
In_Tree.Variable_Elements.Table (Current); In_Tree.Variable_Elements.Table (Current);
......
gcc/ada/prj-util.ads
...@@ -40,6 +40,17 @@ package Prj.Util is ...@@ -40,6 +40,17 @@ package Prj.Util is
-- Executable_Suffix is specified, add this suffix, otherwise add the -- Executable_Suffix is specified, add this suffix, otherwise add the
-- standard executable suffix for the platform. -- standard executable suffix for the platform.
procedure Put
(Into_List : in out Name_List_Index;
From_List : String_List_Id;
In_Tree : Project_Tree_Ref);
-- Append a name list to a string list
procedure Duplicate
(This : in out Name_List_Index;
In_Tree : Project_Tree_Ref);
-- Duplicate a name list
function Value_Of function Value_Of
(Variable : Variable_Value; (Variable : Variable_Value;
Default : String) return String; Default : String) return String;
...@@ -61,7 +72,8 @@ package Prj.Util is ...@@ -61,7 +72,8 @@ package Prj.Util is
(Index : Name_Id; (Index : Name_Id;
Src_Index : Int := 0; Src_Index : Int := 0;
In_Array : Array_Element_Id; In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Variable_Value; In_Tree : Project_Tree_Ref;
Force_Lower_Case_Index : Boolean := False) return Variable_Value;
-- Get a string array component (single String or String list). Returns -- Get a string array component (single String or String list). Returns
-- Nil_Variable_Value if no component Index or if In_Array is null. -- Nil_Variable_Value if no component Index or if In_Array is null.
-- --
...@@ -75,7 +87,8 @@ package Prj.Util is ...@@ -75,7 +87,8 @@ package Prj.Util is
Index : Int := 0; Index : Int := 0;
Attribute_Or_Array_Name : Name_Id; Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id; In_Package : Package_Id;
In_Tree : Project_Tree_Ref) return Variable_Value; In_Tree : Project_Tree_Ref;
Force_Lower_Case_Index : Boolean := False) return Variable_Value;
-- In a specific package, -- In a specific package,
-- - if there exists an array Attribute_Or_Array_Name with an index Name, -- - if there exists an array Attribute_Or_Array_Name with an index Name,
-- returns the corresponding component (depending on the attribute, the -- returns the corresponding component (depending on the attribute, the
......
gcc/ada/prj.adb
...@@ -26,6 +26,7 @@ ...@@ -26,6 +26,7 @@
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with Debug;
with Output; use Output; with Output; use Output;
with Osint; use Osint; with Osint; use Osint;
with Prj.Attr; with Prj.Attr;
...@@ -34,21 +35,28 @@ with Prj.Err; use Prj.Err; ...@@ -34,21 +35,28 @@ with Prj.Err; use Prj.Err;
with Snames; use Snames; with Snames; use Snames;
with Uintp; use Uintp; with Uintp; use Uintp;
with GNAT.Case_Util; use GNAT.Case_Util; with System.Case_Util; use System.Case_Util;
package body Prj is package body Prj is
Object_Suffix : constant String := Get_Target_Object_Suffix.all;
-- File suffix for object files
Initial_Buffer_Size : constant := 100; Initial_Buffer_Size : constant := 100;
-- Initial size for extensible buffer used in Add_To_Buffer -- Initial size for extensible buffer used in Add_To_Buffer
Current_Mode : Mode := Ada_Only;
Configuration_Mode : Boolean := False;
The_Empty_String : Name_Id; The_Empty_String : Name_Id;
Name_C_Plus_Plus : Name_Id; Name_C_Plus_Plus : Name_Id;
Default_Ada_Spec_Suffix_Id : File_Name_Type; Default_Ada_Spec_Suffix_Id : File_Name_Type;
Default_Ada_Body_Suffix_Id : File_Name_Type; Default_Ada_Body_Suffix_Id : File_Name_Type;
Slash_Id : File_Name_Type; Slash_Id : Path_Name_Type;
-- Initialized in Prj.Initialized, then never modified -- Initialized in Prj.Initialize, then never modified
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case; subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
...@@ -63,29 +71,27 @@ package body Prj is ...@@ -63,29 +71,27 @@ package body Prj is
File_Name_Type File_Name_Type
(First_Name_Id + Character'Pos ('-')); (First_Name_Id + Character'Pos ('-'));
Std_Naming_Data : Naming_Data := Std_Naming_Data : constant Naming_Data :=
(Dot_Replacement => Standard_Dot_Replacement, (Dot_Replacement => Standard_Dot_Replacement,
Dot_Repl_Loc => No_Location, Dot_Repl_Loc => No_Location,
Casing => All_Lower_Case, Casing => All_Lower_Case,
Spec_Suffix => No_Array_Element, Spec_Suffix => No_Array_Element,
Ada_Spec_Suffix => No_File, Ada_Spec_Suffix_Loc => No_Location,
Spec_Suffix_Loc => No_Location,
Impl_Suffixes => No_Impl_Suffixes,
Supp_Suffixes => No_Supp_Language_Index,
Body_Suffix => No_Array_Element, Body_Suffix => No_Array_Element,
Ada_Body_Suffix => No_File, Ada_Body_Suffix_Loc => No_Location,
Body_Suffix_Loc => No_Location,
Separate_Suffix => No_File, Separate_Suffix => No_File,
Sep_Suffix_Loc => No_Location, Sep_Suffix_Loc => No_Location,
Specs => No_Array_Element, Specs => No_Array_Element,
Bodies => No_Array_Element, Bodies => No_Array_Element,
Specification_Exceptions => No_Array_Element, Specification_Exceptions => No_Array_Element,
Implementation_Exceptions => No_Array_Element); Implementation_Exceptions => No_Array_Element,
Impl_Suffixes => No_Impl_Suffixes,
Supp_Suffixes => No_Supp_Language_Index);
Project_Empty : Project_Data := Project_Empty : constant Project_Data :=
(Externally_Built => False, (Externally_Built => False,
Languages => No_Languages, Config => Default_Project_Config,
Supp_Languages => No_Supp_Language_Index, Languages => No_Name_List,
First_Referred_By => No_Project, First_Referred_By => No_Project,
Name => No_Name, Name => No_Name,
Display_Name => No_Name, Display_Name => No_Name,
...@@ -104,22 +110,24 @@ package body Prj is ...@@ -104,22 +110,24 @@ package body Prj is
Display_Library_Src_Dir => No_Path, Display_Library_Src_Dir => No_Path,
Library_ALI_Dir => No_Path, Library_ALI_Dir => No_Path,
Display_Library_ALI_Dir => No_Path, Display_Library_ALI_Dir => No_Path,
Library_Name => No_File, Library_Name => No_Name,
Library_Kind => Static, Library_Kind => Static,
Lib_Internal_Name => No_File, Lib_Internal_Name => No_Name,
Standalone_Library => False, Standalone_Library => False,
Lib_Interface_ALIs => Nil_String, Lib_Interface_ALIs => Nil_String,
Lib_Auto_Init => False, Lib_Auto_Init => False,
Libgnarl_Needed => Unknown, Libgnarl_Needed => Unknown,
Symbol_Data => No_Symbols, Symbol_Data => No_Symbols,
Ada_Sources_Present => True, Ada_Sources => Nil_String,
Other_Sources_Present => True,
Sources => Nil_String, Sources => Nil_String,
First_Other_Source => No_Other_Source, First_Source => No_Source,
Last_Other_Source => No_Other_Source, Last_Source => No_Source,
Unit_Based_Language_Name => No_Name,
Unit_Based_Language_Index => No_Language_Index,
Imported_Directories_Switches => null, Imported_Directories_Switches => null,
Include_Path => null, Include_Path => null,
Include_Data_Set => False, Include_Data_Set => False,
Include_Language => No_Language_Index,
Source_Dirs => Nil_String, Source_Dirs => Nil_String,
Known_Order_Of_Source_Dirs => True, Known_Order_Of_Source_Dirs => True,
Object_Directory => No_Path, Object_Directory => No_Path,
...@@ -130,27 +138,45 @@ package body Prj is ...@@ -130,27 +138,45 @@ package body Prj is
Extends => No_Project, Extends => No_Project,
Extended_By => No_Project, Extended_By => No_Project,
Naming => Std_Naming_Data, Naming => Std_Naming_Data,
First_Language_Processing => Default_First_Language_Processing_Data, First_Language_Processing => No_Language_Index,
Supp_Language_Processing => No_Supp_Language_Index,
Default_Linker => No_File,
Default_Linker_Path => No_Path,
Decl => No_Declarations, Decl => No_Declarations,
Imported_Projects => Empty_Project_List, Imported_Projects => Empty_Project_List,
All_Imported_Projects => Empty_Project_List, All_Imported_Projects => Empty_Project_List,
Ada_Include_Path => null, Ada_Include_Path => null,
Ada_Objects_Path => null, Ada_Objects_Path => null,
Objects_Path => null,
Include_Path_File => No_Path, Include_Path_File => No_Path,
Objects_Path_File_With_Libs => No_Path, Objects_Path_File_With_Libs => No_Path,
Objects_Path_File_Without_Libs => No_Path, Objects_Path_File_Without_Libs => No_Path,
Config_File_Name => No_Path, Config_File_Name => No_Path,
Config_File_Temp => False, Config_File_Temp => False,
Linker_Name => No_File,
Linker_Path => No_Path,
Minimum_Linker_Options => No_Name_List,
Config_Checked => False, Config_Checked => False,
Language_Independent_Checked => False,
Checked => False, Checked => False,
Seen => False, Seen => False,
Need_To_Build_Lib => False, Need_To_Build_Lib => False,
Depth => 0, Depth => 0,
Unkept_Comments => False); Unkept_Comments => False,
Langs => No_Languages,
Supp_Languages => No_Supp_Language_Index,
Ada_Sources_Present => True,
Other_Sources_Present => True,
First_Other_Source => No_Other_Source,
Last_Other_Source => No_Other_Source,
First_Lang_Processing => Default_First_Language_Processing_Data,
Supp_Language_Processing => No_Supp_Language_Index);
package Temp_Files is new Table.Table
(Table_Component_Type => Path_Name_Type,
Table_Index_Type => Integer,
Table_Low_Bound => 1,
Table_Initial => 20,
Table_Increment => 100,
Table_Name => "Makegpr.Temp_Files");
-- Table to store the path name of all the created temporary files, so that
-- they can be deleted at the end, or when the program is interrupted.
----------------------- -----------------------
-- Add_Language_Name -- -- Add_Language_Name --
...@@ -183,7 +209,8 @@ package body Prj is ...@@ -183,7 +209,8 @@ package body Prj is
while Last + S'Length > To'Last loop while Last + S'Length > To'Last loop
declare declare
New_Buffer : constant String_Access := new String (1 .. 2 * Last); New_Buffer : constant String_Access :=
new String (1 .. 2 * Last);
begin begin
New_Buffer (1 .. Last) := To (1 .. Last); New_Buffer (1 .. Last) := To (1 .. Last);
...@@ -196,6 +223,124 @@ package body Prj is ...@@ -196,6 +223,124 @@ package body Prj is
Last := Last + S'Length; Last := Last + S'Length;
end Add_To_Buffer; end Add_To_Buffer;
-----------------------
-- Body_Suffix_Id_Of --
-----------------------
function Body_Suffix_Id_Of
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : Naming_Data) return File_Name_Type
is
Language_Id : Name_Id;
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Language);
To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find;
Element_Id := Naming.Body_Suffix;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
if Element.Index = Language_Id then
return File_Name_Type (Element.Value.Value);
end if;
Element_Id := Element.Next;
end loop;
if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix :=
In_Tree.Languages_Data.Table
(Lang).Config.Naming_Data.Body_Suffix;
exit;
end if;
Lang := In_Tree.Languages_Data.Table (Lang).Next;
end loop;
end if;
return Suffix;
end Body_Suffix_Id_Of;
--------------------
-- Body_Suffix_Of --
--------------------
function Body_Suffix_Of
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : Naming_Data) return String
is
Language_Id : Name_Id;
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Language);
To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find;
Element_Id := Naming.Body_Suffix;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
if Element.Index = Language_Id then
return Get_Name_String (Element.Value.Value);
end if;
Element_Id := Element.Next;
end loop;
if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix :=
File_Name_Type
(In_Tree.Languages_Data.Table
(Lang).Config.Naming_Data.Body_Suffix);
exit;
end if;
Lang := In_Tree.Languages_Data.Table (Lang).Next;
end loop;
if Suffix /= No_File then
return Get_Name_String (Suffix);
end if;
end if;
return "";
end Body_Suffix_Of;
function Body_Suffix_Of
(Language : Language_Index;
In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return String
is
Suffix_Id : constant File_Name_Type :=
Suffix_Of (Language, In_Project, In_Tree);
begin
if Suffix_Id /= No_File then
return Get_Name_String (Suffix_Id);
else
return "." & Get_Name_String (Language_Names.Table (Language));
end if;
end Body_Suffix_Of;
----------------------------- -----------------------------
-- Default_Ada_Body_Suffix -- -- Default_Ada_Body_Suffix --
----------------------------- -----------------------------
...@@ -214,6 +359,70 @@ package body Prj is ...@@ -214,6 +359,70 @@ package body Prj is
return Default_Ada_Spec_Suffix_Id; return Default_Ada_Spec_Suffix_Id;
end Default_Ada_Spec_Suffix; end Default_Ada_Spec_Suffix;
----------------------
-- Default_Language --
----------------------
function Default_Language (In_Tree : Project_Tree_Ref) return Name_Id is
begin
return In_Tree.Default_Language;
end Default_Language;
---------------------------
-- Delete_All_Temp_Files --
---------------------------
procedure Delete_All_Temp_Files is
Dont_Care : Boolean;
begin
if not Debug.Debug_Flag_N then
for Index in 1 .. Temp_Files.Last loop
Delete_File
(Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
end loop;
end if;
end Delete_All_Temp_Files;
---------------------
-- Dependency_Name --
---------------------
function Dependency_Name
(Source_File_Name : File_Name_Type;
Dependency : Dependency_File_Kind) return File_Name_Type
is
begin
case Dependency is
when None =>
return No_File;
when Makefile =>
return
File_Name_Type
(Extend_Name
(Source_File_Name, Makefile_Dependency_Suffix));
when ALI_File =>
return
File_Name_Type
(Extend_Name
(Source_File_Name, ALI_Dependency_Suffix));
end case;
end Dependency_Name;
---------------------------
-- Display_Language_Name --
---------------------------
procedure Display_Language_Name
(In_Tree : Project_Tree_Ref;
Language : Language_Index)
is
begin
Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
Write_Str (Name_Buffer (1 .. Name_Len));
end Display_Language_Name;
--------------------------- ---------------------------
-- Display_Language_Name -- -- Display_Language_Name --
--------------------------- ---------------------------
...@@ -225,16 +434,31 @@ package body Prj is ...@@ -225,16 +434,31 @@ package body Prj is
Write_Str (Name_Buffer (1 .. Name_Len)); Write_Str (Name_Buffer (1 .. Name_Len));
end Display_Language_Name; end Display_Language_Name;
----------------
-- Empty_File --
----------------
function Empty_File return File_Name_Type is
begin
return File_Name_Type (The_Empty_String);
end Empty_File;
------------------- -------------------
-- Empty_Project -- -- Empty_Project --
------------------- -------------------
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
Value : Project_Data; Value : Project_Data;
begin begin
Prj.Initialize (Tree => No_Project_Tree); Prj.Initialize (Tree => No_Project_Tree);
Value := Project_Empty; Value := Project_Empty;
Value.Naming := Tree.Private_Part.Default_Naming; Value.Naming := Tree.Private_Part.Default_Naming;
if Current_Mode = Multi_Language then
Value.Config := Tree.Config;
end if;
return Value; return Value;
end Empty_Project; end Empty_Project;
...@@ -258,6 +482,38 @@ package body Prj is ...@@ -258,6 +482,38 @@ package body Prj is
end if; end if;
end Expect; end Expect;
-----------------
-- Extend_Name --
-----------------
function Extend_Name
(File : File_Name_Type;
With_Suffix : String) return File_Name_Type
is
Last : Positive;
begin
Get_Name_String (File);
Last := Name_Len + 1;
while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
Name_Len := Name_Len - 1;
end loop;
if Name_Len <= 1 then
Name_Len := Last;
end if;
for J in With_Suffix'Range loop
Name_Buffer (Name_Len) := With_Suffix (J);
Name_Len := Name_Len + 1;
end loop;
Name_Len := Name_Len - 1;
return Name_Find;
end Extend_Name;
-------------------------------- --------------------------------
-- For_Every_Project_Imported -- -- For_Every_Project_Imported --
-------------------------------- --------------------------------
...@@ -278,7 +534,6 @@ package body Prj is ...@@ -278,7 +534,6 @@ package body Prj is
procedure Recursive_Check (Project : Project_Id) is procedure Recursive_Check (Project : Project_Id) is
List : Project_List; List : Project_List;
begin begin
if not In_Tree.Projects.Table (Project).Seen then if not In_Tree.Projects.Table (Project).Seen then
In_Tree.Projects.Table (Project).Seen := True; In_Tree.Projects.Table (Project).Seen := True;
...@@ -305,16 +560,30 @@ package body Prj is ...@@ -305,16 +560,30 @@ package body Prj is
Recursive_Check (Project => By); Recursive_Check (Project => By);
end For_Every_Project_Imported; end For_Every_Project_Imported;
--------------
-- Get_Mode --
--------------
function Get_Mode return Mode is
begin
return Current_Mode;
end Get_Mode;
---------- ----------
-- Hash -- -- Hash --
---------- ----------
function Hash (Name : File_Name_Type) return Header_Num is
begin
return Hash (Get_Name_String (Name));
end Hash;
function Hash (Name : Name_Id) return Header_Num is function Hash (Name : Name_Id) return Header_Num is
begin begin
return Hash (Get_Name_String (Name)); return Hash (Get_Name_String (Name));
end Hash; end Hash;
function Hash (Name : File_Name_Type) return Header_Num is function Hash (Name : Path_Name_Type) return Header_Num is
begin begin
return Hash (Get_Name_String (Name)); return Hash (Get_Name_String (Name));
end Hash; end Hash;
...@@ -328,6 +597,15 @@ package body Prj is ...@@ -328,6 +597,15 @@ package body Prj is
return The_Casing_Images (Casing).all; return The_Casing_Images (Casing).all;
end Image; end Image;
----------------------
-- In_Configuration --
----------------------
function In_Configuration return Boolean is
begin
return Configuration_Mode;
end In_Configuration;
---------------- ----------------
-- Initialize -- -- Initialize --
---------------- ----------------
...@@ -353,10 +631,6 @@ package body Prj is ...@@ -353,10 +631,6 @@ package body Prj is
Name_Buffer (1 .. 3) := "c++"; Name_Buffer (1 .. 3) := "c++";
Name_C_Plus_Plus := Name_Find; 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;
Project_Empty.Naming := Std_Naming_Data;
Prj.Env.Initialize; Prj.Env.Initialize;
Prj.Attr.Initialize; Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
...@@ -376,6 +650,84 @@ package body Prj is ...@@ -376,6 +650,84 @@ package body Prj is
end if; end if;
end Initialize; end Initialize;
-------------------
-- Is_A_Language --
-------------------
function Is_A_Language
(Tree : Project_Tree_Ref;
Data : Project_Data;
Language_Name : String) return Boolean
is
Lang_Id : Name_Id;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Language_Name);
To_Lower (Name_Buffer (1 .. Name_Len));
Lang_Id := Name_Find;
if Get_Mode = Ada_Only then
declare
List : Name_List_Index := Data.Languages;
begin
while List /= No_Name_List loop
if Tree.Name_Lists.Table (List).Name = Lang_Id then
return True;
else
List := Tree.Name_Lists.Table (List).Next;
end if;
end loop;
end;
else
declare
Lang_Ind : Language_Index;
Lang_Data : Language_Data;
begin
Lang_Ind := Data.First_Language_Processing;
while Lang_Ind /= No_Language_Index loop
Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
if Lang_Data.Name = Lang_Id then
return True;
end if;
Lang_Ind := Lang_Data.Next;
end loop;
end;
end if;
return False;
end Is_A_Language;
------------------
-- Is_Extending --
------------------
function Is_Extending
(Extending : Project_Id;
Extended : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean
is
Proj : Project_Id;
begin
Proj := Extending;
while Proj /= No_Project loop
if Proj = Extended then
return True;
end if;
Proj := In_Tree.Projects.Table (Proj).Extends;
end loop;
return False;
end Is_Extending;
---------------- ----------------
-- Is_Present -- -- Is_Present --
---------------- ----------------
...@@ -391,7 +743,7 @@ package body Prj is ...@@ -391,7 +743,7 @@ package body Prj is
return False; return False;
when First_Language_Indexes => when First_Language_Indexes =>
return In_Project.Languages (Language); return In_Project.Langs (Language);
when others => when others =>
declare declare
...@@ -429,7 +781,7 @@ package body Prj is ...@@ -429,7 +781,7 @@ package body Prj is
return Default_Language_Processing_Data; return Default_Language_Processing_Data;
when First_Language_Indexes => when First_Language_Indexes =>
return In_Project.First_Language_Processing (Language); return In_Project.First_Lang_Processing (Language);
when others => when others =>
declare declare
...@@ -453,6 +805,62 @@ package body Prj is ...@@ -453,6 +805,62 @@ package body Prj is
end case; end case;
end Language_Processing_Data_Of; end Language_Processing_Data_Of;
-----------------------
-- Objects_Exist_For --
-----------------------
function Objects_Exist_For
(Language : String;
In_Tree : Project_Tree_Ref) return Boolean
is
Language_Id : Name_Id;
Lang : Language_Index;
begin
if Current_Mode = Multi_Language then
Name_Len := 0;
Add_Str_To_Name_Buffer (Language);
To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find;
Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
return
In_Tree.Languages_Data.Table
(Lang).Config.Objects_Generated;
end if;
Lang := In_Tree.Languages_Data.Table (Lang).Next;
end loop;
end if;
return True;
end Objects_Exist_For;
-----------------
-- Object_Name --
-----------------
function Object_Name
(Source_File_Name : File_Name_Type)
return File_Name_Type
is
begin
return Extend_Name (Source_File_Name, Object_Suffix);
end Object_Name;
----------------------
-- Record_Temp_File --
----------------------
procedure Record_Temp_File (Path : Path_Name_Type) is
begin
Temp_Files.Increment_Last;
Temp_Files.Table (Temp_Files.Last) := Path;
end Record_Temp_File;
------------------------------------ ------------------------------------
-- Register_Default_Naming_Scheme -- -- Register_Default_Naming_Scheme --
------------------------------------ ------------------------------------
...@@ -508,12 +916,10 @@ package body Prj is ...@@ -508,12 +916,10 @@ package body Prj is
Value => Name_Id (Default_Spec_Suffix), Value => Name_Id (Default_Spec_Suffix),
Index => 0), Index => 0),
Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix); Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
Array_Element_Table.Increment_Last (In_Tree.Array_Elements); Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
In_Tree.Array_Elements.Table In_Tree.Array_Elements.Table
(Array_Element_Table.Last (In_Tree.Array_Elements)) := Element; (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
Element;
In_Tree.Private_Part.Default_Naming.Spec_Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
Array_Element_Table.Last (In_Tree.Array_Elements); Array_Element_Table.Last (In_Tree.Array_Elements);
end if; end if;
...@@ -566,13 +972,26 @@ package body Prj is ...@@ -566,13 +972,26 @@ package body Prj is
----------- -----------
procedure Reset (Tree : Project_Tree_Ref) is procedure Reset (Tree : Project_Tree_Ref) is
-- Def_Lang : constant Name_Node :=
-- (Name => Name_Ada,
-- Next => No_Name_List);
-- Why is the above commented out ???
begin begin
Prj.Env.Initialize; Prj.Env.Initialize;
-- gprmake tables
Present_Language_Table.Init (Tree.Present_Languages); Present_Language_Table.Init (Tree.Present_Languages);
Supp_Suffix_Table.Init (Tree.Supp_Suffixes); Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
Name_List_Table.Init (Tree.Name_Lists);
Supp_Language_Table.Init (Tree.Supp_Languages); Supp_Language_Table.Init (Tree.Supp_Languages);
Other_Source_Table.Init (Tree.Other_Sources); Other_Source_Table.Init (Tree.Other_Sources);
-- Visible tables
Language_Data_Table.Init (Tree.Languages_Data);
Name_List_Table.Init (Tree.Name_Lists);
String_Element_Table.Init (Tree.String_Elements); String_Element_Table.Init (Tree.String_Elements);
Variable_Element_Table.Init (Tree.Variable_Elements); Variable_Element_Table.Init (Tree.Variable_Elements);
Array_Element_Table.Init (Tree.Array_Elements); Array_Element_Table.Init (Tree.Array_Elements);
...@@ -580,9 +999,15 @@ package body Prj is ...@@ -580,9 +999,15 @@ package body Prj is
Package_Table.Init (Tree.Packages); Package_Table.Init (Tree.Packages);
Project_List_Table.Init (Tree.Project_Lists); Project_List_Table.Init (Tree.Project_Lists);
Project_Table.Init (Tree.Projects); Project_Table.Init (Tree.Projects);
Source_Data_Table.Init (Tree.Sources);
Alternate_Language_Table.Init (Tree.Alt_Langs);
Unit_Table.Init (Tree.Units); Unit_Table.Init (Tree.Units);
Units_Htable.Reset (Tree.Units_HT); Units_Htable.Reset (Tree.Units_HT);
Files_Htable.Reset (Tree.Files_HT); Files_Htable.Reset (Tree.Files_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
-- Private part table
Naming_Table.Init (Tree.Private_Part.Namings); Naming_Table.Init (Tree.Private_Part.Namings);
Naming_Table.Increment_Last (Tree.Private_Part.Namings); Naming_Table.Increment_Last (Tree.Private_Part.Namings);
Tree.Private_Part.Namings.Table Tree.Private_Part.Namings.Table
...@@ -591,11 +1016,16 @@ package body Prj is ...@@ -591,11 +1016,16 @@ package body Prj is
Source_Path_Table.Init (Tree.Private_Part.Source_Paths); Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
Object_Path_Table.Init (Tree.Private_Part.Object_Paths); Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
Tree.Private_Part.Default_Naming := Std_Naming_Data; Tree.Private_Part.Default_Naming := Std_Naming_Data;
if Current_Mode = Ada_Only then
Register_Default_Naming_Scheme Register_Default_Naming_Scheme
(Language => Name_Ada, (Language => Name_Ada,
Default_Spec_Suffix => Default_Ada_Spec_Suffix, Default_Spec_Suffix => Default_Ada_Spec_Suffix,
Default_Body_Suffix => Default_Ada_Body_Suffix, Default_Body_Suffix => Default_Ada_Body_Suffix,
In_Tree => Tree); In_Tree => Tree);
Tree.Private_Part.Default_Naming.Separate_Suffix :=
Default_Ada_Body_Suffix;
end if;
end Reset; end Reset;
------------------------ ------------------------
...@@ -608,8 +1038,6 @@ package body Prj is ...@@ -608,8 +1038,6 @@ package body Prj is
begin begin
return Left.Dot_Replacement = Right.Dot_Replacement return Left.Dot_Replacement = Right.Dot_Replacement
and then Left.Casing = Right.Casing and then Left.Casing = Right.Casing
and then Left.Ada_Spec_Suffix = Right.Ada_Spec_Suffix
and then Left.Ada_Body_Suffix = Right.Ada_Body_Suffix
and then Left.Separate_Suffix = Right.Separate_Suffix; and then Left.Separate_Suffix = Right.Separate_Suffix;
end Same_Naming_Scheme; end Same_Naming_Scheme;
...@@ -629,7 +1057,7 @@ package body Prj is ...@@ -629,7 +1057,7 @@ package body Prj is
null; null;
when First_Language_Indexes => when First_Language_Indexes =>
In_Project.Languages (Language) := Present; In_Project.Langs (Language) := Present;
when others => when others =>
declare declare
...@@ -675,16 +1103,16 @@ package body Prj is ...@@ -675,16 +1103,16 @@ package body Prj is
null; null;
when First_Language_Indexes => when First_Language_Indexes =>
In_Project.First_Language_Processing (For_Language) := In_Project.First_Lang_Processing (For_Language) :=
Language_Processing; Language_Processing;
when others => when others =>
declare declare
Supp : Supp_Language_Data; Supp : Supp_Language_Data;
Supp_Index : Supp_Language_Index := Supp_Index : Supp_Language_Index;
In_Project.Supp_Language_Processing;
begin begin
Supp_Index := In_Project.Supp_Language_Processing;
while Supp_Index /= No_Supp_Language_Index loop while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Languages.Table (Supp_Index); Supp := In_Tree.Supp_Languages.Table (Supp_Index);
...@@ -755,15 +1183,216 @@ package body Prj is ...@@ -755,15 +1183,216 @@ package body Prj is
end case; end case;
end Set; end Set;
---------------------
-- Set_Body_Suffix --
---------------------
procedure Set_Body_Suffix
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : in out Naming_Data;
Suffix : File_Name_Type)
is
Language_Id : Name_Id;
Element : Array_Element;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Language);
To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find;
Element :=
(Index => Language_Id,
Src_Index => 0,
Index_Case_Sensitive => False,
Value =>
(Kind => Single,
Project => No_Project,
Location => No_Location,
Default => False,
Value => Name_Id (Suffix),
Index => 0),
Next => Naming.Body_Suffix);
Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
Naming.Body_Suffix :=
Array_Element_Table.Last (In_Tree.Array_Elements);
In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
end Set_Body_Suffix;
--------------------------
-- Set_In_Configuration --
--------------------------
procedure Set_In_Configuration (Value : Boolean) is
begin
Configuration_Mode := Value;
end Set_In_Configuration;
--------------
-- Set_Mode --
--------------
procedure Set_Mode (New_Mode : Mode) is
begin
Current_Mode := New_Mode;
end Set_Mode;
---------------------
-- Set_Spec_Suffix --
---------------------
procedure Set_Spec_Suffix
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : in out Naming_Data;
Suffix : File_Name_Type)
is
Language_Id : Name_Id;
Element : Array_Element;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Language);
To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find;
Element :=
(Index => Language_Id,
Src_Index => 0,
Index_Case_Sensitive => False,
Value =>
(Kind => Single,
Project => No_Project,
Location => No_Location,
Default => False,
Value => Name_Id (Suffix),
Index => 0),
Next => Naming.Spec_Suffix);
Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
Naming.Spec_Suffix :=
Array_Element_Table.Last (In_Tree.Array_Elements);
In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
end Set_Spec_Suffix;
----------- -----------
-- Slash -- -- Slash --
----------- -----------
function Slash return File_Name_Type is function Slash return Path_Name_Type is
begin begin
return Slash_Id; return Slash_Id;
end Slash; end Slash;
-----------------------
-- Spec_Suffix_Id_Of --
-----------------------
function Spec_Suffix_Id_Of
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : Naming_Data) return File_Name_Type
is
Language_Id : Name_Id;
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Language);
To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find;
Element_Id := Naming.Spec_Suffix;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
if Element.Index = Language_Id then
return File_Name_Type (Element.Value.Value);
end if;
Element_Id := Element.Next;
end loop;
if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix :=
In_Tree.Languages_Data.Table
(Lang).Config.Naming_Data.Spec_Suffix;
exit;
end if;
Lang := In_Tree.Languages_Data.Table (Lang).Next;
end loop;
end if;
return Suffix;
end Spec_Suffix_Id_Of;
--------------------
-- Spec_Suffix_Of --
--------------------
function Spec_Suffix_Of
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : Naming_Data) return String
is
Language_Id : Name_Id;
Element_Id : Array_Element_Id;
Element : Array_Element;
Suffix : File_Name_Type := No_File;
Lang : Language_Index;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Language);
To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find;
Element_Id := Naming.Spec_Suffix;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
if Element.Index = Language_Id then
return Get_Name_String (Element.Value.Value);
end if;
Element_Id := Element.Next;
end loop;
if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language;
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix :=
File_Name_Type
(In_Tree.Languages_Data.Table
(Lang).Config.Naming_Data.Spec_Suffix);
exit;
end if;
Lang := In_Tree.Languages_Data.Table (Lang).Next;
end loop;
if Suffix /= No_File then
return Get_Name_String (Suffix);
end if;
end if;
return "";
end Spec_Suffix_Of;
-------------------------- --------------------------
-- Standard_Naming_Data -- -- Standard_Naming_Data --
-------------------------- --------------------------
...@@ -820,6 +1449,40 @@ package body Prj is ...@@ -820,6 +1449,40 @@ package body Prj is
end case; end case;
end Suffix_Of; end Suffix_Of;
-------------------
-- Switches_Name --
-------------------
function Switches_Name
(Source_File_Name : File_Name_Type) return File_Name_Type
is
begin
return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
end Switches_Name;
---------------------------
-- There_Are_Ada_Sources --
---------------------------
function There_Are_Ada_Sources
(In_Tree : Project_Tree_Ref;
Project : Project_Id) return Boolean
is
Prj : Project_Id;
begin
Prj := Project;
while Prj /= No_Project loop
if In_Tree.Projects.Table (Prj).Ada_Sources /= Nil_String then
return True;
end if;
Prj := In_Tree.Projects.Table (Prj).Extends;
end loop;
return False;
end There_Are_Ada_Sources;
----------- -----------
-- Value -- -- Value --
----------- -----------
...@@ -836,8 +1499,9 @@ package body Prj is ...@@ -836,8 +1499,9 @@ package body Prj is
end Value; end Value;
begin begin
-- Make sure that the standard project file extension is compatible -- Make sure that the standard config and user project file extensions are
-- with canonical case file naming. -- compatible with canonical case file naming.
Canonical_Case_File_Name (Config_Project_File_Extension);
Canonical_Case_File_Name (Project_File_Extension); Canonical_Case_File_Name (Project_File_Extension);
end Prj; end Prj;
gcc/ada/prj.ads
...@@ -44,6 +44,31 @@ with System.HTable; ...@@ -44,6 +44,31 @@ with System.HTable;
package Prj is package Prj is
type Library_Support is (None, Static_Only, Full);
-- Support for Library Project File.
-- - None: Library Project Files are not supported at all
-- - Static_Only: Library Project Files are only supported for static
-- libraries.
-- - Full: Library Project Files are supported for static and dynamic
-- (shared) libraries.
type Yes_No_Unknown is (Yes, No, Unknown);
-- Tri-state to decide if -lgnarl is needed when linking
type Mode is (Multi_Language, Ada_Only);
function Get_Mode return Mode;
pragma Inline (Get_Mode);
procedure Set_Mode (New_Mode : Mode);
pragma Inline (Set_Mode);
function In_Configuration return Boolean;
pragma Inline (In_Configuration);
procedure Set_In_Configuration (Value : Boolean);
pragma Inline (Set_In_Configuration);
All_Packages : constant String_List_Access; All_Packages : constant String_List_Access;
-- Default value of parameter Packages of procedures Parse, in Prj.Pars and -- Default value of parameter Packages of procedures Parse, in Prj.Pars and
-- Prj.Part, indicating that all packages should be checked. -- Prj.Part, indicating that all packages should be checked.
...@@ -57,21 +82,23 @@ package Prj is ...@@ -57,21 +82,23 @@ package Prj is
function Default_Ada_Spec_Suffix return File_Name_Type; function Default_Ada_Spec_Suffix return File_Name_Type;
pragma Inline (Default_Ada_Spec_Suffix); pragma Inline (Default_Ada_Spec_Suffix);
-- The Name_Id for the standard GNAT suffix for Ada spec source file -- The name for the standard GNAT suffix for Ada spec source file name
-- name ".ads". Initialized by Prj.Initialize. -- ".ads". Initialized by Prj.Initialize.
function Default_Ada_Body_Suffix return File_Name_Type; function Default_Ada_Body_Suffix return File_Name_Type;
pragma Inline (Default_Ada_Body_Suffix); pragma Inline (Default_Ada_Body_Suffix);
-- The Name_Id for the standard GNAT suffix for Ada body source file -- The name for the standard GNAT suffix for Ada body source file name
-- name ".adb". Initialized by Prj.Initialize. -- ".adb". Initialized by Prj.Initialize.
function Slash return File_Name_Type; function Slash return Path_Name_Type;
pragma Inline (Slash); pragma Inline (Slash);
-- "/", used as the path of locally removed files -- "/", used as the path of locally removed files
Config_Project_File_Extension : String := ".cgpr";
Project_File_Extension : String := ".gpr"; Project_File_Extension : String := ".gpr";
-- The standard project file name extension. It is not a constant, because -- The standard config and user project file name extensions. They are not
-- Canonical_Case_File_Name is called on this variable in the body of Prj. -- constants, because Canonical_Case_File_Name is called on these variables
-- in the body of Prj.
type Error_Warning is (Silent, Warning, Error); type Error_Warning is (Silent, Warning, Error);
-- Severity of some situations, such as: no Ada sources in a project where -- Severity of some situations, such as: no Ada sources in a project where
...@@ -83,109 +110,186 @@ package Prj is ...@@ -83,109 +110,186 @@ package Prj is
-- - Warning: issue a warning, does not cause the tool to fail -- - Warning: issue a warning, does not cause the tool to fail
-- - Error: issue an error, causes the tool to fail -- - Error: issue an error, causes the tool to fail
type Yes_No_Unknown is (Yes, No, Unknown); function Empty_File return File_Name_Type;
-- Tri-state to decide if -lgnarl is needed when linking function Empty_String return Name_Id;
-- Return the id for an empty string ""
----------------------------------------------------- type Project_Id is new Nat;
-- Multi-language Stuff That Will be Modified Soon -- No_Project : constant Project_Id := 0;
----------------------------------------------------- -- Id of a Project File
-- Still should be properly commented ??? type String_List_Id is new Nat;
Nil_String : constant String_List_Id := 0;
type String_Element is record
Value : Name_Id := No_Name;
Index : Int := 0;
Display_Value : Name_Id := No_Name;
Location : Source_Ptr := No_Location;
Flag : Boolean := False;
Next : String_List_Id := Nil_String;
end record;
-- To hold values for string list variables and array elements.
-- Component Flag may be used for various purposes. For source
-- directories, it indicates if the directory contains Ada source(s).
type Language_Index is new Nat; 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);
-- The table for string elements in string lists
No_Language_Index : constant Language_Index := 0; type Variable_Kind is (Undefined, List, Single);
First_Language_Index : constant Language_Index := 1; -- Different kinds of variables
First_Language_Indexes_Last : constant Language_Index := 5;
Ada_Language_Index : constant Language_Index := subtype Defined_Variable_Kind is Variable_Kind range List .. Single;
First_Language_Index; -- The defined kinds of variables
C_Language_Index : constant Language_Index :=
Ada_Language_Index + 1;
C_Plus_Plus_Language_Index : constant Language_Index :=
C_Language_Index + 1;
Last_Language_Index : Language_Index := No_Language_Index; Ignored : constant Variable_Kind;
-- Used to indicate that a package declaration must be ignored
-- while processing the project tree (unknown package name).
subtype First_Language_Indexes is Language_Index type Variable_Value (Kind : Variable_Kind := Undefined) is record
range First_Language_Index .. First_Language_Indexes_Last; Project : Project_Id := No_Project;
Location : Source_Ptr := No_Location;
Default : Boolean := False;
case Kind is
when Undefined =>
null;
when List =>
Values : String_List_Id := Nil_String;
when Single =>
Value : Name_Id := No_Name;
Index : Int := 0;
end case;
end record;
-- Values for variables and array elements. Default is True if the
-- current value is the default one for the variable
type Header_Num is range 0 .. 2047; Nil_Variable_Value : constant Variable_Value;
-- Value of a non existing variable or array element
function Hash is new System.HTable.Hash (Header_Num => Header_Num); type Variable_Id is new Nat;
No_Variable : constant Variable_Id := 0;
type Variable is record
Next : Variable_Id := No_Variable;
Name : Name_Id;
Value : Variable_Value;
end record;
-- To hold the list of variables in a project file and in packages
function Hash (Name : Name_Id) return Header_Num; package Variable_Element_Table is new GNAT.Dynamic_Tables
function Hash (Name : File_Name_Type) return Header_Num; (Table_Component_Type => Variable,
Table_Index_Type => Variable_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100);
-- The table of variable in list of variables
package Language_Indexes is new System.HTable.Simple_HTable type Array_Element_Id is new Nat;
(Header_Num => Header_Num, No_Array_Element : constant Array_Element_Id := 0;
Element => Language_Index, type Array_Element is record
No_Element => No_Language_Index, Index : Name_Id;
Key => Name_Id, Src_Index : Int := 0;
Hash => Hash, Index_Case_Sensitive : Boolean := True;
Equal => "="); Value : Variable_Value;
-- Mapping of language names to language indexes Next : Array_Element_Id := No_Array_Element;
end record;
-- Each Array_Element represents an array element and is linked (Next)
-- to the next array element, if any, in the array.
package Language_Names is new Table.Table package Array_Element_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Id, (Table_Component_Type => Array_Element,
Table_Index_Type => Language_Index, Table_Index_Type => Array_Element_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 4, Table_Initial => 200,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Language_Names"); -- The table that contains all array elements
-- The table for the name of programming languages
procedure Add_Language_Name (Name : Name_Id);
procedure Display_Language_Name (Language : Language_Index); type Array_Id is new Nat;
No_Array : constant Array_Id := 0;
type Array_Data is record
Name : Name_Id := No_Name;
Value : Array_Element_Id := No_Array_Element;
Next : Array_Id := No_Array;
end record;
-- Each Array_Data value represents an array.
-- Value is the id of the first element.
-- Next is the id of the next array in the project file or package.
type Languages_In_Project is array (First_Language_Indexes) of Boolean; package Array_Table is new GNAT.Dynamic_Tables
-- Set of supported languages used in a project (Table_Component_Type => Array_Data,
Table_Index_Type => Array_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100);
-- The table that contains all arrays
No_Languages : constant Languages_In_Project := (others => False); type Package_Id is new Nat;
-- No supported languages are used No_Package : constant Package_Id := 0;
type Declarations is record
Variables : Variable_Id := No_Variable;
Attributes : Variable_Id := No_Variable;
Arrays : Array_Id := No_Array;
Packages : Package_Id := No_Package;
end record;
-- Contains the declarations (variables, single and array attributes,
-- packages) for a project or a package in a project.
type Supp_Language_Index is new Nat; No_Declarations : constant Declarations :=
No_Supp_Language_Index : constant Supp_Language_Index := 0; (Variables => No_Variable,
Attributes => No_Variable,
Arrays => No_Array,
Packages => No_Package);
-- Default value of Declarations: indicates that there is no declarations
type Supp_Language is record type Package_Element is record
Index : Language_Index := No_Language_Index; Name : Name_Id := No_Name;
Present : Boolean := False; Decl : Declarations := No_Declarations;
Next : Supp_Language_Index := No_Supp_Language_Index; Parent : Package_Id := No_Package;
Next : Package_Id := No_Package;
end record; end record;
-- A package (includes declarations that may include other packages)
package Present_Language_Table is new GNAT.Dynamic_Tables package Package_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Supp_Language, (Table_Component_Type => Package_Element,
Table_Index_Type => Supp_Language_Index, Table_Index_Type => Package_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 4, Table_Initial => 100,
Table_Increment => 100); Table_Increment => 100);
-- The table for the presence of languages with an index that is outside -- The table that contains all packages
-- of First_Language_Indexes.
type Impl_Suffix_Array is array (First_Language_Indexes) of File_Name_Type; type Language_Index is new Nat;
-- Suffixes for the non spec sources of the different supported languages
-- in a project.
No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_File); No_Language_Index : constant Language_Index := 0;
-- A default value for the non spec source suffixes
type Supp_Suffix is record procedure Display_Language_Name
Index : Language_Index := No_Language_Index; (In_Tree : Project_Tree_Ref;
Suffix : File_Name_Type := No_File; Language : Language_Index);
Next : Supp_Language_Index := No_Supp_Language_Index;
end record;
package Supp_Suffix_Table is new GNAT.Dynamic_Tables type Header_Num is range 0 .. 2047;
(Table_Component_Type => Supp_Suffix,
Table_Index_Type => Supp_Language_Index, function Hash is new System.HTable.Hash (Header_Num => Header_Num);
Table_Low_Bound => 1,
Table_Initial => 4, function Hash (Name : Name_Id) return Header_Num;
Table_Increment => 100); function Hash (Name : File_Name_Type) return Header_Num;
-- The table for the presence of languages with an index that is outside function Hash (Name : Path_Name_Type) return Header_Num;
-- of First_Language_Indexes.
type Language_Kind is (GNU, other); type Language_Kind is (File_Based, Unit_Based);
type Dependency_File_Kind is (None, Makefile, ALI_File);
Makefile_Dependency_Suffix : constant String := ".d";
ALI_Dependency_Suffix : constant String := ".ali";
Switches_Dependency_Suffix : constant String := ".cswi";
Binder_Exchange_Suffix : constant String := ".bexch";
-- Suffix for binder exchange files
Library_Exchange_Suffix : constant String := ".lexch";
-- Suffix for library exchange files
type Name_List_Index is new Nat; type Name_List_Index is new Nat;
No_Name_List : constant Name_List_Index := 0; No_Name_List : constant Name_List_Index := 0;
...@@ -195,6 +299,8 @@ package Prj is ...@@ -195,6 +299,8 @@ package Prj is
Next : Name_List_Index := No_Name_List; Next : Name_List_Index := No_Name_List;
end record; end record;
function Default_Language (In_Tree : Project_Tree_Ref) return Name_Id;
package Name_List_Table is new GNAT.Dynamic_Tables package Name_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Node, (Table_Component_Type => Name_Node,
Table_Index_Type => Name_List_Index, Table_Index_Type => Name_List_Index,
...@@ -203,80 +309,293 @@ package Prj is ...@@ -203,80 +309,293 @@ package Prj is
Table_Increment => 100); Table_Increment => 100);
-- The table for lists of names used in package Language_Processing -- The table for lists of names used in package Language_Processing
type Language_Processing_Data is record package Mapping_Files_Htable is new Simple_HTable
Compiler_Drivers : Name_List_Index := No_Name_List; (Header_Num => Header_Num,
Compiler_Paths : Name_Id := No_Name; Element => Path_Name_Type,
Compiler_Kinds : Language_Kind := GNU; No_Element => No_Path,
Dependency_Options : Name_List_Index := No_Name_List; Key => Path_Name_Type,
Compute_Dependencies : Name_List_Index := No_Name_List; Hash => Hash,
Include_Options : Name_List_Index := No_Name_List; Equal => "=");
Binder_Drivers : Name_Id := No_Name; -- A hash table to store the mapping files that are not used
Binder_Driver_Paths : Name_Id := No_Name;
type Lang_Naming_Data is record
Dot_Replacement : File_Name_Type := No_File;
-- The string to replace '.' in the source file name (for Ada)
Casing : Casing_Type := All_Lower_Case;
-- The casing of the source file name (for Ada)
Separate_Suffix : File_Name_Type := No_File;
-- String to append to unit name for source file name of an Ada subunit
Spec_Suffix : File_Name_Type := No_File;
-- The string to append to the unit name for the
-- source file name of a spec.
Body_Suffix : File_Name_Type := No_File;
-- The string to append to the unit name for the
-- source file name of a body.
end record; end record;
Default_Language_Processing_Data : No_Lang_Naming_Data : constant Lang_Naming_Data :=
constant Language_Processing_Data := (Dot_Replacement => No_File,
(Compiler_Drivers => No_Name_List, Casing => All_Lower_Case,
Compiler_Paths => No_Name, Separate_Suffix => No_File,
Compiler_Kinds => GNU, Spec_Suffix => No_File,
Dependency_Options => No_Name_List, Body_Suffix => No_File);
Compute_Dependencies => No_Name_List,
Include_Options => No_Name_List, type Source_Id is new Nat;
Binder_Drivers => No_Name,
Binder_Driver_Paths => No_Name); No_Source : constant Source_Id := 0;
-- All the fields in the below record should be commented ???
type Language_Config is record
Kind : Language_Kind := File_Based;
-- Kind of language. All languages are file based, except Ada which is
-- unit based.
Naming_Data : Lang_Naming_Data;
-- The naming data for the languages (prefixs, etc)
Compiler_Driver : File_Name_Type := No_File;
-- The name of the executable for the compiler of the language
Compiler_Driver_Path : String_Access := null;
-- The path name of the executable for the compiler of the language
Compiler_Min_Options : Name_List_Index := No_Name_List;
-- The minimum options for the compiler of the language. Specified
-- in the configuration as Compiler'Switches (<language>).
Min_Compiler_Options : String_List_Access := null;
-- The minimum options as an argument list
Compilation_PIC_Option : Name_List_Index := No_Name_List;
-- The option(s) to compile a source in Position Independent Code for
-- shared libraries. Specified in the configuration. When not specified,
-- there is no need for such switch.
Mapping_File_Switches : Name_List_Index := No_Name_List;
-- The option(s) to provide a mapping file to the compiler. Specified in
-- the configuration. When not ???
Mapping_Spec_Suffix : File_Name_Type := No_File;
Mapping_Body_Suffix : File_Name_Type := No_File;
Config_File_Switches : Name_List_Index := No_Name_List;
Dependency_Kind : Dependency_File_Kind := None;
Dependency_Option : Name_List_Index := No_Name_List;
Compute_Dependency : Name_List_Index := No_Name_List;
Include_Option : Name_List_Index := No_Name_List;
Include_Path : Name_Id := No_Name;
-- Name of an environment variable
Include_Path_File : Name_Id := No_Name;
-- Name of an environment variable
Objects_Path : Name_Id := No_Name;
-- Name of an environment variable
Objects_Path_File : Name_Id := No_Name;
-- Name of an environment variable
Config_Body : Name_Id := No_Name;
Config_Spec : Name_Id := No_Name;
Config_Body_Pattern : Name_Id := No_Name;
Config_Spec_Pattern : Name_Id := No_Name;
Config_File_Unique : Boolean := False;
Runtime_Project : Path_Name_Type := No_Path;
Binder_Driver : File_Name_Type := No_File;
Binder_Driver_Path : Path_Name_Type := No_Path;
Binder_Min_Options : Name_List_Index := No_Name_List;
Binder_Prefix : Name_Id := No_Name;
Toolchain_Version : Name_Id := No_Name;
Toolchain_Description : Name_Id := No_Name;
PIC_Option : Name_Id := No_Name;
Objects_Generated : Boolean := True;
end record;
type First_Language_Processing_Data is No_Language_Config : constant Language_Config :=
array (First_Language_Indexes) of Language_Processing_Data; (Kind => File_Based,
Naming_Data => No_Lang_Naming_Data,
Compiler_Driver => No_File,
Compiler_Driver_Path => null,
Compiler_Min_Options => No_Name_List,
Min_Compiler_Options => null,
Compilation_PIC_Option => No_Name_List,
Mapping_File_Switches => No_Name_List,
Mapping_Spec_Suffix => No_File,
Mapping_Body_Suffix => No_File,
Config_File_Switches => No_Name_List,
Dependency_Kind => Makefile,
Dependency_Option => No_Name_List,
Compute_Dependency => No_Name_List,
Include_Option => No_Name_List,
Include_Path => No_Name,
Include_Path_File => No_Name,
Objects_Path => No_Name,
Objects_Path_File => No_Name,
Config_Body => No_Name,
Config_Spec => No_Name,
Config_Body_Pattern => No_Name,
Config_Spec_Pattern => No_Name,
Config_File_Unique => False,
Runtime_Project => No_Path,
Binder_Driver => No_File,
Binder_Driver_Path => No_Path,
Binder_Min_Options => No_Name_List,
Binder_Prefix => No_Name,
Toolchain_Version => No_Name,
Toolchain_Description => No_Name,
PIC_Option => No_Name,
Objects_Generated => True);
type Language_Data is record
Name : Name_Id := No_Name;
Display_Name : Name_Id := No_Name;
Config : Language_Config := No_Language_Config;
First_Source : Source_Id := No_Source;
Mapping_Files : Mapping_Files_Htable.Instance :=
Mapping_Files_Htable.Nil;
Next : Language_Index := No_Language_Index;
end record;
Default_First_Language_Processing_Data : No_Language_Data : constant Language_Data :=
constant First_Language_Processing_Data := (Name => No_Name,
(others => Default_Language_Processing_Data); Display_Name => No_Name,
Config => No_Language_Config,
First_Source => No_Source,
Mapping_Files => Mapping_Files_Htable.Nil,
Next => No_Language_Index);
type Supp_Language_Data is record package Language_Data_Table is new GNAT.Dynamic_Tables
Index : Language_Index := No_Language_Index; (Table_Component_Type => Language_Data,
Data : Language_Processing_Data := Default_Language_Processing_Data; Table_Index_Type => Language_Index,
Next : Supp_Language_Index := No_Supp_Language_Index; Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100);
-- The table for lists of names used in package Language_Processing
type Alternate_Language_Id is new Nat;
No_Alternate_Language : constant Alternate_Language_Id := 0;
type Alternate_Language_Data is record
Language : Language_Index := No_Language_Index;
Next : Alternate_Language_Id := No_Alternate_Language;
end record; end record;
package Supp_Language_Table is new GNAT.Dynamic_Tables package Alternate_Language_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Supp_Language_Data, (Table_Component_Type => Alternate_Language_Data,
Table_Index_Type => Supp_Language_Index, Table_Index_Type => Alternate_Language_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 4, Table_Initial => 10,
Table_Increment => 100); Table_Increment => 100);
-- The table for language data when there are more languages than -- The table for storing the alternate languages of a header file that
-- in First_Language_Indexes. -- is used for several languages.
type Other_Source_Id is new Nat; type Source_Kind is (Spec, Impl, Sep);
No_Other_Source : constant Other_Source_Id := 0;
type Other_Source is record -- Following record needs full comments on every field ???
Language : Language_Index; -- language of the source
File_Name : File_Name_Type; -- source file simple name type Source_Data is record
Path_Name : Path_Name_Type; -- source full path name Project : Project_Id := No_Project;
Source_TS : Time_Stamp_Type; -- source file time stamp Language_Name : Name_Id := No_Name;
Object_Name : File_Name_Type; -- object file simple name Language : Language_Index := No_Language_Index;
Object_Path : Path_Name_Type; -- object full path name Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
Object_TS : Time_Stamp_Type; -- object file time stamp Kind : Source_Kind := Spec;
Dep_Name : File_Name_Type; -- dependency file simple name Dependency : Dependency_File_Kind := Makefile;
Dep_Path : Path_Name_Type; -- dependency full path name Other_Part : Source_Id := No_Source;
Dep_TS : Time_Stamp_Type; -- dependency file time stamp Unit : Name_Id := No_Name;
Naming_Exception : Boolean := False; -- True if a naming exception Index : Int := 0;
Next : Other_Source_Id := No_Other_Source; Locally_Removed : Boolean := False;
Replaced_By : Source_Id := No_Source;
File : File_Name_Type := No_File;
Display_File : File_Name_Type := No_File;
Path : Path_Name_Type := No_Path;
Display_Path : Path_Name_Type := No_Path;
Source_TS : Time_Stamp_Type := Empty_Time_Stamp;
Object_Project : Project_Id := No_Project;
Object_Exists : Boolean := True;
Object : File_Name_Type := No_File;
Current_Object_Path : Path_Name_Type := No_Path;
Object_Path : Path_Name_Type := No_Path;
Object_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Object file time stamp
Dep_Name : File_Name_Type := No_File;
-- Dependency file simple name
Current_Dep_Path : Path_Name_Type := No_Path;
Dep_Path : Path_Name_Type := No_Path;
-- Dependency full path name
Dep_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Dependency file time stamp
Switches : File_Name_Type := No_File;
Switches_Path : Path_Name_Type := No_Path;
Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
Naming_Exception : Boolean := False;
Next_In_Sources : Source_Id := No_Source;
Next_In_Project : Source_Id := No_Source;
Next_In_Lang : Source_Id := No_Source;
end record; end record;
-- Data for a source in a language other than Ada
package Other_Source_Table is new GNAT.Dynamic_Tables No_Source_Data : constant Source_Data :=
(Table_Component_Type => Other_Source, (Project => No_Project,
Table_Index_Type => Other_Source_Id, Language_Name => No_Name,
Language => No_Language_Index,
Alternate_Languages => No_Alternate_Language,
Kind => Spec,
Dependency => Makefile,
Other_Part => No_Source,
Unit => No_Name,
Index => 0,
Locally_Removed => False,
Replaced_By => No_Source,
File => No_File,
Display_File => No_File,
Path => No_Path,
Display_Path => No_Path,
Source_TS => Empty_Time_Stamp,
Object_Project => No_Project,
Object_Exists => True,
Object => No_File,
Current_Object_Path => No_Path,
Object_Path => No_Path,
Object_TS => Empty_Time_Stamp,
Dep_Name => No_File,
Current_Dep_Path => No_Path,
Dep_Path => No_Path,
Dep_TS => Empty_Time_Stamp,
Switches => No_File,
Switches_Path => No_Path,
Switches_TS => Empty_Time_Stamp,
Naming_Exception => False,
Next_In_Sources => No_Source,
Next_In_Project => No_Source,
Next_In_Lang => No_Source);
package Source_Data_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Source_Data,
Table_Index_Type => Source_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 200, Table_Initial => 1000,
Table_Increment => 100); Table_Increment => 100);
-- The table for sources of languages other than Ada -- The table for the sources
---------------------------------- package Source_Paths_Htable is new Simple_HTable
-- End of multi-language stuff -- (Header_Num => Header_Num,
---------------------------------- Element => Source_Id,
No_Element => No_Source,
Key => Path_Name_Type,
Hash => Hash,
Equal => "=");
-- Mapping of source paths to source ids
type Verbosity is (Default, Medium, High); type Verbosity is (Default, Medium, High);
-- Verbosity when parsing GNAT Project Files -- Verbosity when parsing GNAT Project Files
...@@ -288,6 +607,7 @@ package Prj is ...@@ -288,6 +607,7 @@ package Prj is
-- The current value of the verbosity the project files are parsed with -- The current value of the verbosity the project files are parsed with
type Lib_Kind is (Static, Dynamic, Relocatable); type Lib_Kind is (Static, Dynamic, Relocatable);
type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct); type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct);
-- Type to specify the symbol policy, when symbol control is supported. -- Type to specify the symbol policy, when symbol control is supported.
-- See full explanation about this type in package Symbols. -- See full explanation about this type in package Symbols.
...@@ -298,173 +618,182 @@ package Prj is ...@@ -298,173 +618,182 @@ package Prj is
-- Direct: The symbol file is used as is -- Direct: The symbol file is used as is
type Symbol_Record is record type Symbol_Record is record
Symbol_File : Name_Id := No_Name; Symbol_File : Path_Name_Type := No_Path;
Reference : Name_Id := No_Name; Reference : Path_Name_Type := No_Path;
Symbol_Policy : Policy := Autonomous; Symbol_Policy : Policy := Autonomous;
end record; end record;
-- Type to keep the symbol data to be used when building a shared library -- Type to keep the symbol data to be used when building a shared library
No_Symbols : constant Symbol_Record := No_Symbols : constant Symbol_Record :=
(Symbol_File => No_Name, (Symbol_File => No_Path,
Reference => No_Name, Reference => No_Path,
Symbol_Policy => Autonomous); Symbol_Policy => Autonomous);
-- The default value of the symbol data -- The default value of the symbol data
function Empty_String return Name_Id; function Image (Casing : Casing_Type) return String;
-- Return the Name_Id for an empty string "" -- Similar to 'Image (but avoid use of this attribute in compiler)
type Project_Id is new Nat; function Value (Image : String) return Casing_Type;
No_Project : constant Project_Id := 0; -- Similar to 'Value (but avoid use of this attribute in compiler)
-- Id of a Project File -- Raises Constraint_Error if not a Casing_Type image.
type String_List_Id is new Nat; -- Declarations for gprmake:
Nil_String : constant String_List_Id := 0;
type String_Element is record
Value : Name_Id := No_Name;
Index : Int := 0;
Display_Value : Name_Id := No_Name;
Location : Source_Ptr := No_Location;
Flag : Boolean := False;
Next : String_List_Id := Nil_String;
end record;
-- To hold values for string list variables and array elements.
-- The component Flag may be used for various purposes. For source
-- directories, it indicates if the directory contains Ada source(s).
package String_Element_Table is new GNAT.Dynamic_Tables First_Language_Index : constant Language_Index := 1;
(Table_Component_Type => String_Element, First_Language_Indexes_Last : constant Language_Index := 5;
Table_Index_Type => String_List_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100);
-- The table for string elements in string lists
type Variable_Kind is (Undefined, List, Single); Ada_Language_Index : constant Language_Index :=
-- Different kinds of variables First_Language_Index;
C_Language_Index : constant Language_Index :=
Ada_Language_Index + 1;
C_Plus_Plus_Language_Index : constant Language_Index :=
C_Language_Index + 1;
subtype Defined_Variable_Kind is Variable_Kind range List .. Single; Last_Language_Index : Language_Index := No_Language_Index;
-- The defined kinds of variables
Ignored : constant Variable_Kind; subtype First_Language_Indexes is Language_Index
-- Used to indicate that a package declaration must be ignored range First_Language_Index .. First_Language_Indexes_Last;
-- while processing the project tree (unknown package name).
type Variable_Value (Kind : Variable_Kind := Undefined) is record package Language_Indexes is new System.HTable.Simple_HTable
Project : Project_Id := No_Project; (Header_Num => Header_Num,
Location : Source_Ptr := No_Location; Element => Language_Index,
Default : Boolean := False; No_Element => No_Language_Index,
case Kind is Key => Name_Id,
when Undefined => Hash => Hash,
null; Equal => "=");
when List => -- Mapping of language names to language indexes
Values : String_List_Id := Nil_String;
when Single =>
Value : Name_Id := No_Name;
Index : Int := 0;
end case;
end record;
-- 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; package Language_Names is new Table.Table
-- Value of a non existing variable or array element (Table_Component_Type => Name_Id,
Table_Index_Type => Language_Index,
Table_Low_Bound => 1,
Table_Initial => 4,
Table_Increment => 100,
Table_Name => "Prj.Language_Names");
-- The table for the name of programming languages
type Variable_Id is new Nat; procedure Add_Language_Name (Name : Name_Id);
No_Variable : constant Variable_Id := 0;
type Variable is record
Next : Variable_Id := No_Variable;
Name : Name_Id;
Value : Variable_Value;
end record;
-- To hold the list of variables in a project file and in packages
package Variable_Element_Table is new GNAT.Dynamic_Tables procedure Display_Language_Name (Language : Language_Index);
(Table_Component_Type => Variable,
Table_Index_Type => Variable_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100);
-- The table of variable in list of variables
type Array_Element_Id is new Nat; type Languages_In_Project is array (First_Language_Indexes) of Boolean;
No_Array_Element : constant Array_Element_Id := 0; -- Set of supported languages used in a project
type Array_Element is record
Index : Name_Id; No_Languages : constant Languages_In_Project := (others => False);
Src_Index : Int := 0; -- No supported languages are used
Index_Case_Sensitive : Boolean := True;
Value : Variable_Value; type Supp_Language_Index is new Nat;
Next : Array_Element_Id := No_Array_Element; No_Supp_Language_Index : constant Supp_Language_Index := 0;
type Supp_Language is record
Index : Language_Index := No_Language_Index;
Present : Boolean := False;
Next : Supp_Language_Index := No_Supp_Language_Index;
end record; end record;
-- Each Array_Element represents an array element and is linked (Next)
-- to the next array element, if any, in the array.
package Array_Element_Table is new GNAT.Dynamic_Tables package Present_Language_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Array_Element, (Table_Component_Type => Supp_Language,
Table_Index_Type => Array_Element_Id, Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 200, Table_Initial => 4,
Table_Increment => 100); Table_Increment => 100);
-- The table that contains all array elements -- The table for the presence of languages with an index that is outside
-- of First_Language_Indexes.
type Array_Id is new Nat; type Impl_Suffix_Array is array (First_Language_Indexes) of File_Name_Type;
No_Array : constant Array_Id := 0; -- Suffixes for the non spec sources of the different supported languages
type Array_Data is record -- in a project.
Name : Name_Id := No_Name;
Value : Array_Element_Id := No_Array_Element; No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_File);
Next : Array_Id := No_Array; -- A default value for the non spec source suffixes
type Supp_Suffix is record
Index : Language_Index := No_Language_Index;
Suffix : File_Name_Type := No_File;
Next : Supp_Language_Index := No_Supp_Language_Index;
end record; end record;
-- Each Array_Data value represents an array.
-- Value is the id of the first element.
-- Next is the id of the next array in the project file or package.
package Array_Table is new GNAT.Dynamic_Tables package Supp_Suffix_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Array_Data, (Table_Component_Type => Supp_Suffix,
Table_Index_Type => Array_Id, Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 200, Table_Initial => 4,
Table_Increment => 100); Table_Increment => 100);
-- The table that contains all arrays -- The table for the presence of languages with an index that is outside
-- of First_Language_Indexes.
type Package_Id is new Nat; type Lang_Kind is (GNU, Other);
No_Package : constant Package_Id := 0;
type Declarations is record type Language_Processing_Data is record
Variables : Variable_Id := No_Variable; Compiler_Drivers : Name_List_Index := No_Name_List;
Attributes : Variable_Id := No_Variable; Compiler_Paths : Name_Id := No_Name;
Arrays : Array_Id := No_Array; Compiler_Kinds : Lang_Kind := GNU;
Packages : Package_Id := No_Package; Dependency_Options : Name_List_Index := No_Name_List;
Compute_Dependencies : Name_List_Index := No_Name_List;
Include_Options : Name_List_Index := No_Name_List;
Binder_Drivers : Name_Id := No_Name;
Binder_Driver_Paths : Name_Id := No_Name;
end record; end record;
-- Contains the declarations (variables, single and array attributes,
-- packages) for a project or a package in a project.
No_Declarations : constant Declarations := Default_Language_Processing_Data :
(Variables => No_Variable, constant Language_Processing_Data :=
Attributes => No_Variable, (Compiler_Drivers => No_Name_List,
Arrays => No_Array, Compiler_Paths => No_Name,
Packages => No_Package); Compiler_Kinds => GNU,
-- Default value of Declarations: indicates that there is no declarations Dependency_Options => No_Name_List,
Compute_Dependencies => No_Name_List,
Include_Options => No_Name_List,
Binder_Drivers => No_Name,
Binder_Driver_Paths => No_Name);
type Package_Element is record type First_Language_Processing_Data is
Name : Name_Id := No_Name; array (First_Language_Indexes) of Language_Processing_Data;
Decl : Declarations := No_Declarations;
Parent : Package_Id := No_Package; Default_First_Language_Processing_Data :
Next : Package_Id := No_Package; constant First_Language_Processing_Data :=
(others => Default_Language_Processing_Data);
type Supp_Language_Data is record
Index : Language_Index := No_Language_Index;
Data : Language_Processing_Data := Default_Language_Processing_Data;
Next : Supp_Language_Index := No_Supp_Language_Index;
end record; end record;
-- A package (includes declarations that may include other packages)
package Package_Table is new GNAT.Dynamic_Tables package Supp_Language_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Package_Element, (Table_Component_Type => Supp_Language_Data,
Table_Index_Type => Package_Id, Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 100, Table_Initial => 4,
Table_Increment => 100); Table_Increment => 100);
-- The table that contains all packages -- The table for language data when there are more languages than
-- in First_Language_Indexes.
function Image (Casing : Casing_Type) return String; type Other_Source_Id is new Nat;
-- Similar to 'Image (but avoid use of this attribute in compiler) No_Other_Source : constant Other_Source_Id := 0;
function Value (Image : String) return Casing_Type; type Other_Source is record
-- Similar to 'Value (but avoid use of this attribute in compiler) Language : Language_Index; -- language of the source
-- Raises Constraint_Error if not a Casing_Type image. File_Name : File_Name_Type; -- source file simple name
Path_Name : Path_Name_Type; -- source full path name
Source_TS : Time_Stamp_Type; -- source file time stamp
Object_Name : File_Name_Type; -- object file simple name
Object_Path : Path_Name_Type; -- object full path name
Object_TS : Time_Stamp_Type; -- object file time stamp
Dep_Name : File_Name_Type; -- dependency file simple name
Dep_Path : Path_Name_Type; -- dependency full path name
Dep_TS : Time_Stamp_Type; -- dependency file time stamp
Naming_Exception : Boolean := False; -- True if a naming exception
Next : Other_Source_Id := No_Other_Source;
end record;
-- Data for a source in a language other than Ada
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);
-- The table for sources of languages other than Ada
-- The following record contains data for a naming scheme -- The following record contains data for a naming scheme
...@@ -474,8 +803,6 @@ package Prj is ...@@ -474,8 +803,6 @@ package Prj is
-- The string to replace '.' in the source file name (for Ada) -- The string to replace '.' in the source file name (for Ada)
Dot_Repl_Loc : Source_Ptr := No_Location; Dot_Repl_Loc : Source_Ptr := No_Location;
-- The position in the project file source where Dot_Replacement is
-- defined.
Casing : Casing_Type := All_Lower_Case; Casing : Casing_Type := All_Lower_Case;
-- The casing of the source file name (for Ada) -- The casing of the source file name (for Ada)
...@@ -485,28 +812,14 @@ package Prj is ...@@ -485,28 +812,14 @@ package Prj is
-- source file name of a spec. -- source file name of a spec.
-- Indexed by the programming language. -- Indexed by the programming language.
Ada_Spec_Suffix : File_Name_Type := No_File; Ada_Spec_Suffix_Loc : Source_Ptr := No_Location;
-- The suffix of the Ada spec sources
Spec_Suffix_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
-- Ada_Spec_Suffix is defined.
Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes;
Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index;
-- The source suffixes of the different languages
Body_Suffix : Array_Element_Id := No_Array_Element; Body_Suffix : Array_Element_Id := No_Array_Element;
-- The string to append to the unit name for the -- The string to append to the unit name for the
-- source file name of a body. -- source file name of a body.
-- Indexed by the programming language. -- Indexed by the programming language.
Ada_Body_Suffix : File_Name_Type := No_File; Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
-- The suffix of the Ada body sources
Body_Suffix_Loc : Source_Ptr := No_Location;
-- The position in the project file source where
-- Ada_Body_Suffix is defined.
Separate_Suffix : File_Name_Type := No_File; Separate_Suffix : File_Name_Type := No_File;
-- String to append to unit name for source file name of an Ada subunit -- String to append to unit name for source file name of an Ada subunit
...@@ -530,8 +843,48 @@ package Prj is ...@@ -530,8 +843,48 @@ package Prj is
-- An associative array listing body file names that do not have the -- An associative array listing body file names that do not have the
-- body suffix. Not used by Ada. Indexed by programming language name. -- body suffix. Not used by Ada. Indexed by programming language name.
-- For gprmake:
Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes;
Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index;
end record; end record;
function Spec_Suffix_Of
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : Naming_Data) return String;
function Spec_Suffix_Id_Of
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : Naming_Data) return File_Name_Type;
procedure Set_Spec_Suffix
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : in out Naming_Data;
Suffix : File_Name_Type);
function Body_Suffix_Id_Of
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : Naming_Data) return File_Name_Type;
function Body_Suffix_Of
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : Naming_Data) return String;
procedure Set_Body_Suffix
(In_Tree : Project_Tree_Ref;
Language : String;
Naming : in out Naming_Data;
Suffix : File_Name_Type);
function Objects_Exist_For
(Language : String;
In_Tree : Project_Tree_Ref) return Boolean;
function Standard_Naming_Data function Standard_Naming_Data
(Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data; (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data;
pragma Inline (Standard_Naming_Data); pragma Inline (Standard_Naming_Data);
...@@ -563,28 +916,141 @@ package Prj is ...@@ -563,28 +916,141 @@ package Prj is
Table_Increment => 100); Table_Increment => 100);
-- The table that contains the lists of project files -- The table that contains the lists of project files
type Project_Configuration is record
Run_Path_Option : Name_List_Index := No_Name_List;
-- The option to use when linking to specify the path where to look
-- for libraries.
Executable_Suffix : Name_Id := No_Name;
-- The suffix of executables, when specified in the configuration or
-- in package Builder of the main project. When this is not
-- specified, the executable suffix is the default for the platform.
-- Linking
Linker : Path_Name_Type := No_Path;
-- Path name of the linker driver; specified in the configuration
-- or in the package Builder of the main project.
Minimum_Linker_Options : Name_List_Index := No_Name_List;
-- The minimum options for the linker driver; specified in the
-- configuration.
Linker_Executable_Option : Name_List_Index := No_Name_List;
-- The option(s) to indicate the name of the executable in the
-- linker command. Specified in the configuration. When not
-- specified, default to -o <executable name>.
Linker_Lib_Dir_Option : Name_Id := No_Name;
-- The option to specify where to find a library for linking.
-- Specified in the configuration. When not specified, defaults to
-- "-L".
Linker_Lib_Name_Option : Name_Id := No_Name;
-- The option to specify the name of a library for linking.
-- Specified in the configuration. When not specified, defaults to
-- "-l".
-- Libraries
Library_Builder : Path_Name_Type := No_Path;
-- The executable to build library. Specified in the configuration.
Lib_Support : Library_Support := None;
-- The level of library support. Specified in the configuration.
-- Support is none, static libraries only or both static and shared
-- libraries.
-- Archives
Archive_Builder : Name_List_Index := No_Name_List;
-- The name of the executable to build archives, with the minimum
-- switches. Specified in the configuration.
Archive_Indexer : Name_List_Index := No_Name_List;
-- The name of the executable to index archives, with the minimum
-- switches. Specified in the configuration.
Archive_Suffix : File_Name_Type := No_File;
-- The suffix of archives. Specified in the configuration. When not
-- specified, defaults to ".a".
Lib_Partial_Linker : Name_List_Index := No_Name_List;
-- Shared libraries
Shared_Lib_Prefix : File_Name_Type := No_File;
-- Part of a shared library file name that precedes the name of the
-- library. Specified in the configuration. When not specified,
-- defaults to "lib".
Shared_Lib_Suffix : File_Name_Type := No_File;
-- Suffix of shared libraries, after the library name in the shared
-- library name. Specified in the configuration. When not specified,
-- default to ".so".
Shared_Lib_Min_Options : Name_List_Index := No_Name_List;
--
Lib_Version_Options : Name_List_Index := No_Name_List;
--
Symbolic_Link_Supported : Boolean := False;
--
Lib_Maj_Min_Id_Supported : Boolean := False;
--
Auto_Init_Supported : Boolean := False;
--
end record;
Default_Project_Config : constant Project_Configuration :=
(Run_Path_Option => No_Name_List,
Executable_Suffix => No_Name,
Linker => No_Path,
Minimum_Linker_Options => No_Name_List,
Linker_Executable_Option => No_Name_List,
Linker_Lib_Dir_Option => No_Name,
Linker_Lib_Name_Option => No_Name,
Library_Builder => No_Path,
Lib_Support => None,
Archive_Builder => No_Name_List,
Archive_Indexer => No_Name_List,
Archive_Suffix => No_File,
Lib_Partial_Linker => No_Name_List,
Shared_Lib_Prefix => No_File,
Shared_Lib_Suffix => No_File,
Shared_Lib_Min_Options => No_Name_List,
Lib_Version_Options => No_Name_List,
Symbolic_Link_Supported => False,
Lib_Maj_Min_Id_Supported => False,
Auto_Init_Supported => False);
-- The following record describes a project file representation -- The following record describes a project file representation
type Project_Data is record type Project_Data is record
Externally_Built : Boolean := False; Externally_Built : Boolean := False;
-- True if the project is externally built. In such case, the Project
-- Manager will not modify anything in this project.
Languages : Languages_In_Project := No_Languages; Languages : Name_List_Index := No_Name_List;
Supp_Languages : Supp_Language_Index := No_Supp_Language_Index; -- The list of languages of the sources of this project
-- Indicate the different languages of the source of this project
Config : Project_Configuration;
First_Referred_By : Project_Id := No_Project; First_Referred_By : Project_Id := No_Project;
-- The project, if any, that was the first to be known as importing or -- The project, if any, that was the first to be known as importing or
-- extending this project. Set by Prj.Proc.Process. -- extending this project
Name : Name_Id := No_Name; Name : Name_Id := No_Name;
-- The name of the project. Set by Prj.Proc.Process -- The name of the project
Display_Name : Name_Id := No_Name; Display_Name : Name_Id := No_Name;
-- The name of the project with the spelling of its declaration. -- The name of the project with the spelling of its declaration
-- Set by Prj.Proc.Process.
Path_Name : Path_Name_Type := No_Path; Path_Name : Path_Name_Type := No_Path;
-- The path name of the project file. Set by Prj.Proc.Process -- The path name of the project file
Display_Path_Name : Path_Name_Type := No_Path; Display_Path_Name : Path_Name_Type := No_Path;
-- The path name used for display purposes. May be different from -- The path name used for display purposes. May be different from
...@@ -594,83 +1060,76 @@ package Prj is ...@@ -594,83 +1060,76 @@ package Prj is
-- True for virtual extending projects -- True for virtual extending projects
Location : Source_Ptr := No_Location; Location : Source_Ptr := No_Location;
-- The location in the project file source of the reserved word -- The location in the project file source of the reserved word project
-- project. Set by Prj.Proc.Process.
Mains : String_List_Id := Nil_String; Mains : String_List_Id := Nil_String;
-- List of mains specified by attribute Main. Set by Prj.Nmsc.Check -- List of mains specified by attribute Main
Directory : Path_Name_Type := No_Path; Directory : Path_Name_Type := No_Path;
-- Directory where the project file resides. Set by Prj.Proc.Process -- Path name of the directory where the project file resides
Display_Directory : Path_Name_Type := No_Path; Display_Directory : Path_Name_Type := No_Path;
-- Project directory path name for display purposes. May be different -- The path name of the project directory, for display purposes. May be
-- from Directory for platforms where file names are case-insensitive. -- different from Directory for platforms where the file names are
-- case-insensitive.
Dir_Path : String_Access; Dir_Path : String_Access;
-- Same as Directory, but as an access to String. Set by -- Same as Directory, but as an access to String
-- Make.Compile_Sources.Collect_Arguments_And_Compile.
Library : Boolean := False; Library : Boolean := False;
-- True if this is a library project. Set by -- True if this is a library project
-- Prj.Nmsc.Language_Independent_Check.
Library_Dir : Path_Name_Type := No_Path; Library_Dir : Path_Name_Type := No_Path;
-- If a library project, directory where the library Set by -- If a library project, path name of the directory where the library
-- Prj.Nmsc.Language_Independent_Check. -- resides.
Display_Library_Dir : Path_Name_Type := No_Path; Display_Library_Dir : Path_Name_Type := No_Path;
-- The name of the library directory, for display purposes. May be -- The path name of the library directory, for display purposes. May be
-- different from Library_Dir for platforms where the file names are -- different from Library_Dir for platforms where the file names are
-- case-insensitive. -- case-insensitive.
Library_TS : Time_Stamp_Type := Empty_Time_Stamp; Library_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- The timestamp of a library file in a library project. -- The timestamp of a library file in a library project
-- Set by MLib.Prj.Check_Library.
Library_Src_Dir : Path_Name_Type := No_Path; Library_Src_Dir : Path_Name_Type := No_Path;
-- If a Stand-Alone Library project, directory where the sources -- If a Stand-Alone Library project, path name of the directory where
-- of the interfaces of the library are copied. By default, if -- the sources of the interfaces of the library are copied. By default,
-- attribute Library_Src_Dir is not specified, sources of the interfaces -- if attribute Library_Src_Dir is not specified, sources of the
-- are not copied anywhere. Set by Prj.Nmsc.Check_Stand_Alone_Library. -- interfaces are not copied anywhere.
Display_Library_Src_Dir : Path_Name_Type := No_Path; Display_Library_Src_Dir : Path_Name_Type := No_Path;
-- The name of the library source directory, for display purposes. -- The path name of the library source directory, for display purposes.
-- May be different from Library_Src_Dir for platforms where the file -- May be different from Library_Src_Dir for platforms where the file
-- names are case-insensitive. -- names are case-insensitive.
Library_ALI_Dir : Path_Name_Type := No_Path; Library_ALI_Dir : Path_Name_Type := No_Path;
-- In a library project, directory where the ALI files are copied. -- In a library project, path name of the directory where the ALI files
-- If attribute Library_ALI_Dir is not specified, ALI files are -- are copied. If attribute Library_ALI_Dir is not specified, ALI files
-- copied in the Library_Dir. Set by Prj.Nmsc.Check_Library_Attributes. -- are copied in the Library_Dir.
Display_Library_ALI_Dir : Path_Name_Type := No_Path; Display_Library_ALI_Dir : Path_Name_Type := No_Path;
-- The name of the library ALI directory, for display purposes. May be -- The path name of the library ALI directory, for display purposes. May
-- different from Library_ALI_Dir for platforms where the file names are -- be different from Library_ALI_Dir for platforms where the file names
-- case-insensitive. -- are case-insensitive.
Library_Name : File_Name_Type := No_File; Library_Name : Name_Id := No_Name;
-- If a library project, name of the library -- If a library project, name of the library
-- Set by Prj.Nmsc.Language_Independent_Check.
Library_Kind : Lib_Kind := Static; Library_Kind : Lib_Kind := Static;
-- If a library project, kind of library -- If a library project, kind of library
-- Set by Prj.Nmsc.Language_Independent_Check.
Lib_Internal_Name : File_Name_Type := No_File; Lib_Internal_Name : Name_Id := No_Name;
-- If a library project, internal name store inside the library Set by -- If a library project, internal name store inside the library
-- Prj.Nmsc.Language_Independent_Check.
Standalone_Library : Boolean := False; Standalone_Library : Boolean := False;
-- Indicate that this is a Standalone Library Project File. Set by -- Indicate that this is a Standalone Library Project File
-- Prj.Nmsc.Check.
Lib_Interface_ALIs : String_List_Id := Nil_String; Lib_Interface_ALIs : String_List_Id := Nil_String;
-- For Standalone Library Project Files, indicate the list of Interface -- For Standalone Library Project Files, indicate the list of Interface
-- ALI files. Set by Prj.Nmsc.Check. -- ALI files.
Lib_Auto_Init : Boolean := False; Lib_Auto_Init : Boolean := False;
-- For non static Standalone Library Project Files, indicate if -- For non static Stand-Alone Library Project Files, indicate if
-- the library initialisation should be automatic. -- the library initialisation should be automatic.
Libgnarl_Needed : Yes_No_Unknown := Unknown; Libgnarl_Needed : Yes_No_Unknown := Unknown;
...@@ -679,38 +1138,40 @@ package Prj is ...@@ -679,38 +1138,40 @@ package Prj is
Symbol_Data : Symbol_Record := No_Symbols; Symbol_Data : Symbol_Record := No_Symbols;
-- Symbol file name, reference symbol file name, symbol policy -- Symbol file name, reference symbol file name, symbol policy
Ada_Sources_Present : Boolean := True; Ada_Sources : String_List_Id := Nil_String;
-- A flag that indicates if there are Ada sources in this project file. -- The list of all the Ada source file names (gnatmake only).
-- There are no sources if any of the following is true:
-- 1) Source_Dirs is specified as an empty list
-- 2) Source_Files is specified as an empty list
-- 3) Ada is not in the list of the specified Languages
Other_Sources_Present : Boolean := True;
-- A flag that indicates that there are non-Ada sources in this project
Sources : String_List_Id := Nil_String; Sources : String_List_Id := Nil_String;
-- The list of all the source file names. -- Identical to Ada_Sources. For upward compatibility of GPS.
-- Set by Prj.Nmsc.Check_Ada_Naming_Scheme.
First_Other_Source : Other_Source_Id := No_Other_Source; First_Source : Source_Id := No_Source;
Last_Other_Source : Other_Source_Id := No_Other_Source; Last_Source : Source_Id := No_Source;
-- Head and tail of the list of sources of languages other than Ada -- Head and tail of the list of sources
Unit_Based_Language_Name : Name_Id := No_Name;
Unit_Based_Language_Index : Language_Index := No_Language_Index;
-- The name and index, if any, of the unit-based language of some
-- sources of the project. There may be only one unit-based language
-- in one project.
Imported_Directories_Switches : Argument_List_Access := null; Imported_Directories_Switches : Argument_List_Access := null;
-- List of the -I switches to be used when compiling sources of -- List of the source search switches (-I<source dir>) to be used when
-- languages other than Ada. -- compiling.
Include_Path : String_Access := null; Include_Path : String_Access := null;
-- Value to be used as CPATH, when using a GCC, instead of a list of -- Value of the environment variable to indicate the source search path,
-- -I switches. -- instead of a list of switches (Imported_Directories_Switches).
Include_Path_File : Path_Name_Type := No_Path;
-- The path name of the of the source search directory file
Include_Data_Set : Boolean := False; Include_Data_Set : Boolean := False;
-- Set True when Imported_Directories_Switches or Include_Path are set -- Set True when Imported_Directories_Switches or Include_Path are set
Include_Language : Language_Index := No_Language_Index;
Source_Dirs : String_List_Id := Nil_String; Source_Dirs : String_List_Id := Nil_String;
-- The list of all the source directories. -- The list of all the source directories
-- Set by Prj.Nmsc.Language_Independent_Check.
Known_Order_Of_Source_Dirs : Boolean := True; Known_Order_Of_Source_Dirs : Boolean := True;
-- False, if there is any /** in the Source_Dirs, because in this case -- False, if there is any /** in the Source_Dirs, because in this case
...@@ -718,100 +1179,90 @@ package Prj is ...@@ -718,100 +1179,90 @@ package Prj is
-- duplicate file names in the same project file are allowed. -- duplicate file names in the same project file are allowed.
Object_Directory : Path_Name_Type := No_Path; Object_Directory : Path_Name_Type := No_Path;
-- The object directory of this project file. -- The path name of the object directory of this project file
-- Set by Prj.Nmsc.Language_Independent_Check.
Display_Object_Dir : Path_Name_Type := No_Path; Display_Object_Dir : Path_Name_Type := No_Path;
-- The name of the object directory, for display purposes. -- The path name of the object directory, for display purposes. May be
-- May be different from Object_Directory for platforms where the file -- different from Object_Directory for platforms where the file names
-- names are case-insensitive. -- are case-insensitive.
Exec_Directory : Path_Name_Type := No_Path; Exec_Directory : Path_Name_Type := No_Path;
-- The exec directory of this project file. Default is equal to -- The path name of the exec directory of this project file. Default is
-- Object_Directory. Set by Prj.Nmsc.Language_Independent_Check. -- equal to Object_Directory.
Display_Exec_Dir : Path_Name_Type := No_Path; Display_Exec_Dir : Path_Name_Type := No_Path;
-- The name of the exec directory, for display purposes. May be -- The path name of the exec directory, for display purposes. May be
-- different from Exec_Directory for platforms where the file names are -- different from Exec_Directory for platforms where the file names are
-- case-insensitive. -- case-insensitive.
Extends : Project_Id := No_Project; Extends : Project_Id := No_Project;
-- The reference of the project file, if any, that this project file -- The reference of the project file, if any, that this project file
-- extends. Set by Prj.Proc.Process. -- extends.
Extended_By : Project_Id := No_Project; Extended_By : Project_Id := No_Project;
-- The reference of the project file, if any, that extends this project -- The reference of the project file, if any, that extends this project
-- file. Set by Prj.Proc.Process. -- file.
Naming : Naming_Data := Standard_Naming_Data; Naming : Naming_Data := Standard_Naming_Data;
-- The naming scheme of this project file. -- The naming scheme of this project file
-- Set by Prj.Nmsc.Check_Naming_Scheme.
First_Language_Processing : First_Language_Processing_Data := First_Language_Processing : Language_Index := No_Language_Index;
Default_First_Language_Processing_Data;
-- Comment needed ??? -- Comment needed ???
Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index;
-- Comment needed
Default_Linker : File_Name_Type := No_File;
Default_Linker_Path : Path_Name_Type := No_Path;
Decl : Declarations := No_Declarations; Decl : Declarations := No_Declarations;
-- The declarations (variables, attributes and packages) of this -- The declarations (variables, attributes and packages) of this project
-- project file. Set by Prj.Proc.Process. -- file.
Imported_Projects : Project_List := Empty_Project_List; Imported_Projects : Project_List := Empty_Project_List;
-- The list of all directly imported projects, if any. Set by -- The list of all directly imported projects, if any
-- Prj.Proc.Process.
All_Imported_Projects : Project_List := Empty_Project_List; All_Imported_Projects : Project_List := Empty_Project_List;
-- The list of all projects imported directly or indirectly, if any. -- The list of all projects imported directly or indirectly, if any
-- Set by Make.Initialize.
Ada_Include_Path : String_Access := null; Ada_Include_Path : String_Access := null;
-- The cached value of ADA_INCLUDE_PATH for this project file. Do not -- The cached value of ADA_INCLUDE_PATH for this project file. Do not
-- use this field directly outside of the compiler, use -- use this field directly outside of the compiler, use
-- Prj.Env.Ada_Include_Path instead. Set by Prj.Env.Ada_Include_Path. -- Prj.Env.Ada_Include_Path instead.
Ada_Objects_Path : String_Access := null; Ada_Objects_Path : String_Access := null;
-- The cached value of ADA_OBJECTS_PATH for this project file. Do not -- The cached value of ADA_OBJECTS_PATH for this project file. Do not
-- use this field directly outside of the compiler, use -- use this field directly outside of the compiler, use
-- Prj.Env.Ada_Objects_Path instead. Set by Prj.Env.Ada_Objects_Path -- Prj.Env.Ada_Objects_Path instead.
Include_Path_File : Path_Name_Type := No_Path; Objects_Path : String_Access := null;
-- The cached value of the source path temp file for this project file. -- ???
-- Set by gnatmake (Prj.Env.Set_Ada_Paths).
Objects_Path_File_With_Libs : Path_Name_Type := No_Path; Objects_Path_File_With_Libs : Path_Name_Type := No_Path;
-- The cached value of the object path temp file (including library -- The cached value of the object path temp file (including library
-- dirs) for this project file. Set by gnatmake (Prj.Env.Set_Ada_Paths). -- dirs) for this project file.
Objects_Path_File_Without_Libs : Path_Name_Type := No_Path; Objects_Path_File_Without_Libs : Path_Name_Type := No_Path;
-- The cached value of the object path temp file (excluding library -- The cached value of the object path temp file (excluding library
-- dirs) for this project file. Set by gnatmake (Prj.Env.Set_Ada_Paths). -- dirs) for this project file.
Config_File_Name : Path_Name_Type := No_Path; Config_File_Name : Path_Name_Type := No_Path;
-- The name of the configuration pragmas file, if any. -- The path name of the configuration pragmas file, if any
-- Set by gnatmake (Prj.Env.Create_Config_Pragmas_File).
Config_File_Temp : Boolean := False; Config_File_Temp : Boolean := False;
-- An indication that the configuration pragmas file is -- An indication that the configuration pragmas file is a temporary file
-- a temporary file that must be deleted at the end. -- that must be deleted at the end.
-- Set by gnatmake (Prj.Env.Create_Config_Pragmas_File).
Config_Checked : Boolean := False; Linker_Name : File_Name_Type := No_File;
-- A flag to avoid checking repetitively the configuration pragmas file. -- Value of attribute Language_Processing'Linker in the project file
-- Set by gnatmake (Prj.Env.Create_Config_Pragmas_File).
Linker_Path : Path_Name_Type := No_Path;
-- Path of linker when attribute Language_Processing'Linker is specified
Language_Independent_Checked : Boolean := False; Minimum_Linker_Options : Name_List_Index := No_Name_List;
-- A flag that indicates that the project file has been checked -- List of options specified in attribute
-- for language independent features: Object_Directory, -- Language_Processing'Minimum_Linker_Options.
-- Source_Directories, Library, non empty Naming Suffixes.
Config_Checked : Boolean := False;
-- A flag to avoid checking repetitively the configuration pragmas file
Checked : Boolean := False; Checked : Boolean := False;
-- A flag to avoid checking repetitively the naming scheme of -- A flag to avoid checking repetitively the naming scheme of this
-- this project file. Set by Prj.Nmsc.Check_Ada_Naming_Scheme. -- project file.
Seen : Boolean := False; Seen : Boolean := False;
-- A flag to mark a project as "visited" to avoid processing the same -- A flag to mark a project as "visited" to avoid processing the same
...@@ -822,18 +1273,46 @@ package Prj is ...@@ -822,18 +1273,46 @@ package Prj is
-- rebuilt. -- rebuilt.
Depth : Natural := 0; Depth : Natural := 0;
-- The maximum depth of a project in the project graph. -- The maximum depth of a project in the project graph. Depth of main
-- Depth of main project is 0. -- project is 0.
Unkept_Comments : Boolean := False; Unkept_Comments : Boolean := False;
-- True if there are comments in the project sources that cannot -- True if there are comments in the project sources that cannot be kept
-- be kept in the project tree. -- in the project tree.
-- For gprmake
Langs : Languages_In_Project := No_Languages;
Supp_Languages : Supp_Language_Index := No_Supp_Language_Index;
-- Indicate the different languages of the source of this project
Ada_Sources_Present : Boolean := True;
Other_Sources_Present : Boolean := True;
First_Other_Source : Other_Source_Id := No_Other_Source;
Last_Other_Source : Other_Source_Id := No_Other_Source;
First_Lang_Processing : First_Language_Processing_Data :=
Default_First_Language_Processing_Data;
Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index;
end record; end record;
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data; function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
-- Return the representation of an empty project in project Tree tree. -- Return the representation of an empty project in project Tree tree.
-- The project tree Tree must have been Initialized and/or Reset. -- The project tree Tree must have been Initialized and/or Reset.
function Is_Extending
(Extending : Project_Id;
Extended : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean;
function Is_A_Language
(Tree : Project_Tree_Ref;
Data : Project_Data;
Language_Name : String) return Boolean;
function There_Are_Ada_Sources
(In_Tree : Project_Tree_Ref;
Project : Project_Id) return Boolean;
Project_Error : exception; Project_Error : exception;
-- Raised by some subprograms in Prj.Attr -- Raised by some subprograms in Prj.Attr
...@@ -852,8 +1331,8 @@ package Prj is ...@@ -852,8 +1331,8 @@ package Prj is
Name : File_Name_Type := No_File; Name : File_Name_Type := No_File;
Index : Int := 0; Index : Int := 0;
Display_Name : File_Name_Type := No_File; Display_Name : File_Name_Type := No_File;
Path : File_Name_Type := No_File; Path : Path_Name_Type := No_Path;
Display_Path : File_Name_Type := No_File; Display_Path : Path_Name_Type := No_Path;
Project : Project_Id := No_Project; Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False; Needs_Pragma : Boolean := False;
end record; end record;
...@@ -861,8 +1340,8 @@ package Prj is ...@@ -861,8 +1340,8 @@ package Prj is
type File_Names_Data is array (Spec_Or_Body) of File_Name_Data; type File_Names_Data is array (Spec_Or_Body) of File_Name_Data;
type Unit_Id is new Nat; type Unit_Index is new Nat;
No_Unit : constant Unit_Id := 0; No_Unit_Index : constant Unit_Index := 0;
type Unit_Data is record type Unit_Data is record
Name : Name_Id := No_Name; Name : Name_Id := No_Name;
File_Names : File_Names_Data; File_Names : File_Names_Data;
...@@ -872,7 +1351,7 @@ package Prj is ...@@ -872,7 +1351,7 @@ package Prj is
package Unit_Table is new GNAT.Dynamic_Tables package Unit_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Unit_Data, (Table_Component_Type => Unit_Data,
Table_Index_Type => Unit_Id, Table_Index_Type => Unit_Index,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 100, Table_Initial => 100,
Table_Increment => 100); Table_Increment => 100);
...@@ -880,19 +1359,19 @@ package Prj is ...@@ -880,19 +1359,19 @@ package Prj is
package Units_Htable is new Simple_HTable package Units_Htable is new Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Unit_Id, Element => Unit_Index,
No_Element => No_Unit, No_Element => No_Unit_Index,
Key => Name_Id, Key => Name_Id,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- Mapping of unit names to indexes in the Units table -- Mapping of unit names to indexes in the Units table
type Unit_Project is record type Unit_Project is record
Unit : Unit_Id := No_Unit; Unit : Unit_Index := No_Unit_Index;
Project : Project_Id := No_Project; Project : Project_Id := No_Project;
end record; end record;
No_Unit_Project : constant Unit_Project := (No_Unit, No_Project); No_Unit_Project : constant Unit_Project := (No_Unit_Index, No_Project);
package Files_Htable is new Simple_HTable package Files_Htable is new Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
...@@ -908,11 +1387,26 @@ package Prj is ...@@ -908,11 +1387,26 @@ package Prj is
type Project_Tree_Data is type Project_Tree_Data is
record record
Present_Languages : Present_Language_Table.Instance; -- General
Supp_Suffixes : Supp_Suffix_Table.Instance;
Default_Language : Name_Id := No_Name;
-- The name of the language of the sources of a project, when
-- attribute Languages is not specified.
Config : Project_Configuration;
-- Languages and sources of the project
First_Language : Language_Index := No_Language_Index;
--
First_Source : Source_Id := No_Source;
--
-- Tables
Languages_Data : Language_Data_Table.Instance;
Name_Lists : Name_List_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; String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance; Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance; Array_Elements : Array_Element_Table.Instance;
...@@ -920,9 +1414,22 @@ package Prj is ...@@ -920,9 +1414,22 @@ package Prj is
Packages : Package_Table.Instance; Packages : Package_Table.Instance;
Project_Lists : Project_List_Table.Instance; Project_Lists : Project_List_Table.Instance;
Projects : Project_Table.Instance; Projects : Project_Table.Instance;
Sources : Source_Data_Table.Instance;
Alt_Langs : Alternate_Language_Table.Instance;
Units : Unit_Table.Instance; Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance; Units_HT : Units_Htable.Instance;
Files_HT : Files_Htable.Instance; Files_HT : Files_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance;
-- For gprmake:
Present_Languages : Present_Language_Table.Instance;
Supp_Suffixes : Supp_Suffix_Table.Instance;
Supp_Languages : Supp_Language_Table.Instance;
Other_Sources : Other_Source_Table.Instance;
-- Private part
Private_Part : Private_Project_Tree_Data; Private_Part : Private_Project_Tree_Data;
end record; end record;
-- Data for a project tree -- Data for a project tree
...@@ -975,9 +1482,32 @@ package Prj is ...@@ -975,9 +1482,32 @@ package Prj is
-- that are extended by other projects are not considered. With_State may -- 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. -- be used by Action to choose a behavior or to report some global result.
---------------------------------------------------------- function Extend_Name
-- Other multi-language stuff that may be modified soon -- (File : File_Name_Type;
---------------------------------------------------------- With_Suffix : String) return File_Name_Type;
-- Replace the extension of File with With_Suffix
function Object_Name
(Source_File_Name : File_Name_Type) return File_Name_Type;
-- Returns the object file name corresponding to a source file name
function Dependency_Name
(Source_File_Name : File_Name_Type;
Dependency : Dependency_File_Kind) return File_Name_Type;
-- Returns the dependency file name corresponding to a source file name
function Switches_Name
(Source_File_Name : File_Name_Type) return File_Name_Type;
-- Returns the switches file name corresponding to a source file name
-- For gprmake
function Body_Suffix_Of
(Language : Language_Index;
In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return String;
-- Returns the suffix of sources of language Language in project In_Project
-- in project tree In_Tree.
function Is_Present function Is_Present
(Language : Language_Index; (Language : Language_Index;
...@@ -1023,6 +1553,17 @@ package Prj is ...@@ -1023,6 +1553,17 @@ package Prj is
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref);
-- Set the suffix for language Language in project In_Project -- Set the suffix for language Language in project In_Project
----------------
-- Temp Files --
----------------
procedure Record_Temp_File (Path : Path_Name_Type);
-- Record the path of a newly created temporary file, so that it can be
-- deleted later.
procedure Delete_All_Temp_Files;
-- Delete all recorded temporary files
private private
All_Packages : constant String_List_Access := null; All_Packages : constant String_List_Access := null;
...@@ -1071,7 +1612,7 @@ private ...@@ -1071,7 +1612,7 @@ private
-- Used by Delete_All_Path_Files. -- Used by Delete_All_Path_Files.
package Source_Path_Table is new GNAT.Dynamic_Tables package Source_Path_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => File_Name_Type, (Table_Component_Type => Name_Id,
Table_Index_Type => Natural, Table_Index_Type => Natural,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 50, Table_Initial => 50,
...@@ -1093,5 +1634,7 @@ private ...@@ -1093,5 +1634,7 @@ private
Object_Paths : Object_Path_Table.Instance; Object_Paths : Object_Path_Table.Instance;
Default_Naming : Naming_Data; Default_Naming : Naming_Data;
end record; end record;
-- Comment ??? -- Type to represent the part of a project tree which is private to the
-- Project Manager.
end Prj; end Prj;
gcc/ada/snames.adb
...@@ -33,6 +33,7 @@ ...@@ -33,6 +33,7 @@
with Opt; use Opt; with Opt; use Opt;
with Table; with Table;
with Types; use Types;
package body Snames is package body Snames is
...@@ -179,6 +180,7 @@ package body Snames is ...@@ -179,6 +180,7 @@ package body Snames is
"ada_2005#" & "ada_2005#" &
"assertion_policy#" & "assertion_policy#" &
"c_pass_by_copy#" & "c_pass_by_copy#" &
"check_name#" &
"compile_time_error#" & "compile_time_error#" &
"compile_time_warning#" & "compile_time_warning#" &
"component_alignment#" & "component_alignment#" &
...@@ -192,6 +194,7 @@ package body Snames is ...@@ -192,6 +194,7 @@ package body Snames is
"extensions_allowed#" & "extensions_allowed#" &
"external_name_casing#" & "external_name_casing#" &
"float_representation#" & "float_representation#" &
"implicit_packing#" &
"initialize_scalars#" & "initialize_scalars#" &
"interrupt_state#" & "interrupt_state#" &
"license#" & "license#" &
...@@ -447,6 +450,7 @@ package body Snames is ...@@ -447,6 +450,7 @@ package body Snames is
"digits#" & "digits#" &
"elaborated#" & "elaborated#" &
"emax#" & "emax#" &
"enabled#" &
"enum_rep#" & "enum_rep#" &
"epsilon#" & "epsilon#" &
"exponent#" & "exponent#" &
...@@ -672,16 +676,12 @@ package body Snames is ...@@ -672,16 +676,12 @@ package body Snames is
"archive_indexer#" & "archive_indexer#" &
"archive_suffix#" & "archive_suffix#" &
"binder#" & "binder#" &
"binder_driver#" &
"binder_prefix#" & "binder_prefix#" &
"body_suffix#" & "body_suffix#" &
"builder#" & "builder#" &
"builder_switches#" & "builder_switches#" &
"compiler#" & "compiler#" &
"compiler_driver#" &
"compiler_kind#" & "compiler_kind#" &
"compiler_pic_option#" &
"compute_dependency#" &
"config_body_file_name#" & "config_body_file_name#" &
"config_body_file_name_pattern#" & "config_body_file_name_pattern#" &
"config_file_switches#" & "config_file_switches#" &
...@@ -689,21 +689,18 @@ package body Snames is ...@@ -689,21 +689,18 @@ package body Snames is
"config_spec_file_name#" & "config_spec_file_name#" &
"config_spec_file_name_pattern#" & "config_spec_file_name_pattern#" &
"cross_reference#" & "cross_reference#" &
"default_builder_switches#" &
"default_global_compiler_switches#" &
"default_language#" & "default_language#" &
"default_linker#" &
"default_minimum_linker_options#" &
"default_switches#" & "default_switches#" &
"dependency_driver#" &
"dependency_file_kind#" & "dependency_file_kind#" &
"dependency_option#" & "dependency_switches#" &
"driver#" &
"exec_dir#" & "exec_dir#" &
"executable#" & "executable#" &
"executable_suffix#" & "executable_suffix#" &
"extends#" & "extends#" &
"externally_built#" & "externally_built#" &
"finder#" & "finder#" &
"global_compiler_switches#" &
"global_configuration_pragmas#" & "global_configuration_pragmas#" &
"global_config_file#" & "global_config_file#" &
"gnatls#" & "gnatls#" &
...@@ -735,7 +732,7 @@ package body Snames is ...@@ -735,7 +732,7 @@ package body Snames is
"library_symbol_file#" & "library_symbol_file#" &
"library_symbol_policy#" & "library_symbol_policy#" &
"library_version#" & "library_version#" &
"library_version_options#" & "library_version_switches#" &
"linker#" & "linker#" &
"linker_executable_option#" & "linker_executable_option#" &
"linker_lib_dir_option#" & "linker_lib_dir_option#" &
...@@ -747,19 +744,19 @@ package body Snames is ...@@ -747,19 +744,19 @@ package body Snames is
"mapping_spec_suffix#" & "mapping_spec_suffix#" &
"mapping_body_suffix#" & "mapping_body_suffix#" &
"metrics#" & "metrics#" &
"minimum_binder_options#" &
"minimum_compiler_options#" &
"minimum_linker_options#" &
"naming#" & "naming#" &
"objects_path#" & "objects_path#" &
"objects_path_file#" & "objects_path_file#" &
"object_dir#" & "object_dir#" &
"pic_option#" &
"pretty_printer#" & "pretty_printer#" &
"prefix#" &
"project#" & "project#" &
"roots#" & "roots#" &
"required_switches#" &
"run_path_option#" & "run_path_option#" &
"runtime_project#" & "runtime_project#" &
"shared_library_minimum_options#" & "shared_library_minimum_switches#" &
"shared_library_prefix#" & "shared_library_prefix#" &
"shared_library_suffix#" & "shared_library_suffix#" &
"separate_suffix#" & "separate_suffix#" &
...@@ -853,15 +850,6 @@ package body Snames is ...@@ -853,15 +850,6 @@ package body Snames is
return Attribute_Id'Val (N - First_Attribute_Name); return Attribute_Id'Val (N - First_Attribute_Name);
end Get_Attribute_Id; end Get_Attribute_Id;
------------------
-- Get_Check_Id --
------------------
function Get_Check_Id (N : Name_Id) return Check_Id is
begin
return Check_Id'Val (N - First_Check_Name);
end Get_Check_Id;
----------------------- -----------------------
-- Get_Convention_Id -- -- Get_Convention_Id --
----------------------- -----------------------
...@@ -1032,15 +1020,6 @@ package body Snames is ...@@ -1032,15 +1020,6 @@ package body Snames is
return N in First_Attribute_Name .. Last_Attribute_Name; return N in First_Attribute_Name .. Last_Attribute_Name;
end Is_Attribute_Name; end Is_Attribute_Name;
-------------------
-- Is_Check_Name --
-------------------
function Is_Check_Name (N : Name_Id) return Boolean is
begin
return N in First_Check_Name .. Last_Check_Name;
end Is_Check_Name;
------------------------ ------------------------
-- Is_Convention_Name -- -- Is_Convention_Name --
------------------------ ------------------------
......
gcc/ada/snames.ads
...@@ -32,7 +32,6 @@ ...@@ -32,7 +32,6 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Namet; use Namet; with Namet; use Namet;
with Types; use Types;
package Snames is package Snames is
...@@ -342,58 +341,60 @@ package Snames is ...@@ -342,58 +341,60 @@ package Snames is
Name_Ada_2005 : constant Name_Id := N + 119; -- GNAT Name_Ada_2005 : constant Name_Id := N + 119; -- GNAT
Name_Assertion_Policy : constant Name_Id := N + 120; -- Ada 05 Name_Assertion_Policy : constant Name_Id := N + 120; -- Ada 05
Name_C_Pass_By_Copy : constant Name_Id := N + 121; -- GNAT Name_C_Pass_By_Copy : constant Name_Id := N + 121; -- GNAT
Name_Compile_Time_Error : constant Name_Id := N + 122; -- GNAT Name_Check_Name : constant Name_Id := N + 122; -- GNAT
Name_Compile_Time_Warning : constant Name_Id := N + 123; -- GNAT Name_Compile_Time_Error : constant Name_Id := N + 123; -- GNAT
Name_Component_Alignment : constant Name_Id := N + 124; -- GNAT Name_Compile_Time_Warning : constant Name_Id := N + 124; -- GNAT
Name_Convention_Identifier : constant Name_Id := N + 125; -- GNAT Name_Component_Alignment : constant Name_Id := N + 125; -- GNAT
Name_Debug_Policy : constant Name_Id := N + 126; -- GNAT Name_Convention_Identifier : constant Name_Id := N + 126; -- GNAT
Name_Detect_Blocking : constant Name_Id := N + 127; -- Ada 05 Name_Debug_Policy : constant Name_Id := N + 127; -- GNAT
Name_Discard_Names : constant Name_Id := N + 128; Name_Detect_Blocking : constant Name_Id := N + 128; -- Ada 05
Name_Elaboration_Checks : constant Name_Id := N + 129; -- GNAT Name_Discard_Names : constant Name_Id := N + 129;
Name_Eliminate : constant Name_Id := N + 130; -- GNAT Name_Elaboration_Checks : constant Name_Id := N + 130; -- GNAT
Name_Extend_System : constant Name_Id := N + 131; -- GNAT Name_Eliminate : constant Name_Id := N + 131; -- GNAT
Name_Extensions_Allowed : constant Name_Id := N + 132; -- GNAT Name_Extend_System : constant Name_Id := N + 132; -- GNAT
Name_External_Name_Casing : constant Name_Id := N + 133; -- GNAT Name_Extensions_Allowed : constant Name_Id := N + 133; -- GNAT
Name_Float_Representation : constant Name_Id := N + 134; -- GNAT Name_External_Name_Casing : constant Name_Id := N + 134; -- GNAT
Name_Initialize_Scalars : constant Name_Id := N + 135; -- GNAT Name_Float_Representation : constant Name_Id := N + 135; -- GNAT
Name_Interrupt_State : constant Name_Id := N + 136; -- GNAT Name_Implicit_Packing : constant Name_Id := N + 136; -- GNAT
Name_License : constant Name_Id := N + 137; -- GNAT Name_Initialize_Scalars : constant Name_Id := N + 137; -- GNAT
Name_Locking_Policy : constant Name_Id := N + 138; Name_Interrupt_State : constant Name_Id := N + 138; -- GNAT
Name_Long_Float : constant Name_Id := N + 139; -- VMS Name_License : constant Name_Id := N + 139; -- GNAT
Name_No_Run_Time : constant Name_Id := N + 140; -- GNAT Name_Locking_Policy : constant Name_Id := N + 140;
Name_No_Strict_Aliasing : constant Name_Id := N + 141; -- GNAT Name_Long_Float : constant Name_Id := N + 141; -- VMS
Name_Normalize_Scalars : constant Name_Id := N + 142; Name_No_Run_Time : constant Name_Id := N + 142; -- GNAT
Name_Polling : constant Name_Id := N + 143; -- GNAT Name_No_Strict_Aliasing : constant Name_Id := N + 143; -- GNAT
Name_Persistent_BSS : constant Name_Id := N + 144; -- GNAT Name_Normalize_Scalars : constant Name_Id := N + 144;
Name_Priority_Specific_Dispatching : constant Name_Id := N + 145; -- Ada 05 Name_Polling : constant Name_Id := N + 145; -- GNAT
Name_Profile : constant Name_Id := N + 146; -- Ada 05 Name_Persistent_BSS : constant Name_Id := N + 146; -- GNAT
Name_Profile_Warnings : constant Name_Id := N + 147; -- GNAT Name_Priority_Specific_Dispatching : constant Name_Id := N + 147; -- Ada 05
Name_Propagate_Exceptions : constant Name_Id := N + 148; -- GNAT Name_Profile : constant Name_Id := N + 148; -- Ada 05
Name_Queuing_Policy : constant Name_Id := N + 149; Name_Profile_Warnings : constant Name_Id := N + 149; -- GNAT
Name_Ravenscar : constant Name_Id := N + 150; -- GNAT Name_Propagate_Exceptions : constant Name_Id := N + 150; -- GNAT
Name_Restricted_Run_Time : constant Name_Id := N + 151; -- GNAT Name_Queuing_Policy : constant Name_Id := N + 151;
Name_Restrictions : constant Name_Id := N + 152; Name_Ravenscar : constant Name_Id := N + 152; -- GNAT
Name_Restriction_Warnings : constant Name_Id := N + 153; -- GNAT Name_Restricted_Run_Time : constant Name_Id := N + 153; -- GNAT
Name_Reviewable : constant Name_Id := N + 154; Name_Restrictions : constant Name_Id := N + 154;
Name_Source_File_Name : constant Name_Id := N + 155; -- GNAT Name_Restriction_Warnings : constant Name_Id := N + 155; -- GNAT
Name_Source_File_Name_Project : constant Name_Id := N + 156; -- GNAT Name_Reviewable : constant Name_Id := N + 156;
Name_Style_Checks : constant Name_Id := N + 157; -- GNAT Name_Source_File_Name : constant Name_Id := N + 157; -- GNAT
Name_Suppress : constant Name_Id := N + 158; Name_Source_File_Name_Project : constant Name_Id := N + 158; -- GNAT
Name_Suppress_Exception_Locations : constant Name_Id := N + 159; -- GNAT Name_Style_Checks : constant Name_Id := N + 159; -- GNAT
Name_Task_Dispatching_Policy : constant Name_Id := N + 160; Name_Suppress : constant Name_Id := N + 160;
Name_Universal_Data : constant Name_Id := N + 161; -- AAMP Name_Suppress_Exception_Locations : constant Name_Id := N + 161; -- GNAT
Name_Unsuppress : constant Name_Id := N + 162; -- GNAT Name_Task_Dispatching_Policy : constant Name_Id := N + 162;
Name_Use_VADS_Size : constant Name_Id := N + 163; -- GNAT Name_Universal_Data : constant Name_Id := N + 163; -- AAMP
Name_Validity_Checks : constant Name_Id := N + 164; -- GNAT Name_Unsuppress : constant Name_Id := N + 164; -- GNAT
Name_Warnings : constant Name_Id := N + 165; -- GNAT Name_Use_VADS_Size : constant Name_Id := N + 165; -- GNAT
Name_Wide_Character_Encoding : constant Name_Id := N + 166; -- GNAT Name_Validity_Checks : constant Name_Id := N + 166; -- GNAT
Last_Configuration_Pragma_Name : constant Name_Id := N + 166; Name_Warnings : constant Name_Id := N + 167; -- GNAT
Name_Wide_Character_Encoding : constant Name_Id := N + 168; -- GNAT
Last_Configuration_Pragma_Name : constant Name_Id := N + 168;
-- Remaining pragma names -- Remaining pragma names
Name_Abort_Defer : constant Name_Id := N + 167; -- GNAT Name_Abort_Defer : constant Name_Id := N + 169; -- GNAT
Name_All_Calls_Remote : constant Name_Id := N + 168; Name_All_Calls_Remote : constant Name_Id := N + 170;
Name_Annotate : constant Name_Id := N + 169; -- GNAT Name_Annotate : constant Name_Id := N + 171; -- GNAT
-- Note: AST_Entry is not in this list because its name matches the -- Note: AST_Entry is not in this list because its name matches the
-- name of the corresponding attribute. However, it is included in the -- name of the corresponding attribute. However, it is included in the
...@@ -401,73 +402,73 @@ package Snames is ...@@ -401,73 +402,73 @@ package Snames is
-- and Check_Pragma_Id correctly recognize and process Name_AST_Entry. -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry.
-- AST_Entry is a VMS specific pragma. -- AST_Entry is a VMS specific pragma.
Name_Assert : constant Name_Id := N + 170; -- Ada 05 Name_Assert : constant Name_Id := N + 172; -- Ada 05
Name_Asynchronous : constant Name_Id := N + 171; Name_Asynchronous : constant Name_Id := N + 173;
Name_Atomic : constant Name_Id := N + 172; Name_Atomic : constant Name_Id := N + 174;
Name_Atomic_Components : constant Name_Id := N + 173; Name_Atomic_Components : constant Name_Id := N + 175;
Name_Attach_Handler : constant Name_Id := N + 174; Name_Attach_Handler : constant Name_Id := N + 176;
Name_CIL_Constructor : constant Name_Id := N + 175; -- GNAT Name_CIL_Constructor : constant Name_Id := N + 177; -- GNAT
Name_Comment : constant Name_Id := N + 176; -- GNAT Name_Comment : constant Name_Id := N + 178; -- GNAT
Name_Common_Object : constant Name_Id := N + 177; -- GNAT Name_Common_Object : constant Name_Id := N + 179; -- GNAT
Name_Complete_Representation : constant Name_Id := N + 178; -- GNAT Name_Complete_Representation : constant Name_Id := N + 180; -- GNAT
Name_Complex_Representation : constant Name_Id := N + 179; -- GNAT Name_Complex_Representation : constant Name_Id := N + 181; -- GNAT
Name_Controlled : constant Name_Id := N + 180; Name_Controlled : constant Name_Id := N + 182;
Name_Convention : constant Name_Id := N + 181; Name_Convention : constant Name_Id := N + 183;
Name_CPP_Class : constant Name_Id := N + 182; -- GNAT Name_CPP_Class : constant Name_Id := N + 184; -- GNAT
Name_CPP_Constructor : constant Name_Id := N + 183; -- GNAT Name_CPP_Constructor : constant Name_Id := N + 185; -- GNAT
Name_CPP_Virtual : constant Name_Id := N + 184; -- GNAT Name_CPP_Virtual : constant Name_Id := N + 186; -- GNAT
Name_CPP_Vtable : constant Name_Id := N + 185; -- GNAT Name_CPP_Vtable : constant Name_Id := N + 187; -- GNAT
Name_Debug : constant Name_Id := N + 186; -- GNAT Name_Debug : constant Name_Id := N + 188; -- GNAT
Name_Elaborate : constant Name_Id := N + 187; -- Ada 83 Name_Elaborate : constant Name_Id := N + 189; -- Ada 83
Name_Elaborate_All : constant Name_Id := N + 188; Name_Elaborate_All : constant Name_Id := N + 190;
Name_Elaborate_Body : constant Name_Id := N + 189; Name_Elaborate_Body : constant Name_Id := N + 191;
Name_Export : constant Name_Id := N + 190; Name_Export : constant Name_Id := N + 192;
Name_Export_Exception : constant Name_Id := N + 191; -- VMS Name_Export_Exception : constant Name_Id := N + 193; -- VMS
Name_Export_Function : constant Name_Id := N + 192; -- GNAT Name_Export_Function : constant Name_Id := N + 194; -- GNAT
Name_Export_Object : constant Name_Id := N + 193; -- GNAT Name_Export_Object : constant Name_Id := N + 195; -- GNAT
Name_Export_Procedure : constant Name_Id := N + 194; -- GNAT Name_Export_Procedure : constant Name_Id := N + 196; -- GNAT
Name_Export_Value : constant Name_Id := N + 195; -- GNAT Name_Export_Value : constant Name_Id := N + 197; -- GNAT
Name_Export_Valued_Procedure : constant Name_Id := N + 196; -- GNAT Name_Export_Valued_Procedure : constant Name_Id := N + 198; -- GNAT
Name_External : constant Name_Id := N + 197; -- GNAT Name_External : constant Name_Id := N + 199; -- GNAT
Name_Finalize_Storage_Only : constant Name_Id := N + 198; -- GNAT Name_Finalize_Storage_Only : constant Name_Id := N + 200; -- GNAT
Name_Ident : constant Name_Id := N + 199; -- VMS Name_Ident : constant Name_Id := N + 201; -- VMS
Name_Import : constant Name_Id := N + 200; Name_Import : constant Name_Id := N + 202;
Name_Import_Exception : constant Name_Id := N + 201; -- VMS Name_Import_Exception : constant Name_Id := N + 203; -- VMS
Name_Import_Function : constant Name_Id := N + 202; -- GNAT Name_Import_Function : constant Name_Id := N + 204; -- GNAT
Name_Import_Object : constant Name_Id := N + 203; -- GNAT Name_Import_Object : constant Name_Id := N + 205; -- GNAT
Name_Import_Procedure : constant Name_Id := N + 204; -- GNAT Name_Import_Procedure : constant Name_Id := N + 206; -- GNAT
Name_Import_Valued_Procedure : constant Name_Id := N + 205; -- GNAT Name_Import_Valued_Procedure : constant Name_Id := N + 207; -- GNAT
Name_Inline : constant Name_Id := N + 206; Name_Inline : constant Name_Id := N + 208;
Name_Inline_Always : constant Name_Id := N + 207; -- GNAT Name_Inline_Always : constant Name_Id := N + 209; -- GNAT
Name_Inline_Generic : constant Name_Id := N + 208; -- GNAT Name_Inline_Generic : constant Name_Id := N + 210; -- GNAT
Name_Inspection_Point : constant Name_Id := N + 209; Name_Inspection_Point : constant Name_Id := N + 211;
Name_Interface_Name : constant Name_Id := N + 210; -- GNAT Name_Interface_Name : constant Name_Id := N + 212; -- GNAT
Name_Interrupt_Handler : constant Name_Id := N + 211; Name_Interrupt_Handler : constant Name_Id := N + 213;
Name_Interrupt_Priority : constant Name_Id := N + 212; Name_Interrupt_Priority : constant Name_Id := N + 214;
Name_Java_Constructor : constant Name_Id := N + 213; -- GNAT Name_Java_Constructor : constant Name_Id := N + 215; -- GNAT
Name_Java_Interface : constant Name_Id := N + 214; -- GNAT Name_Java_Interface : constant Name_Id := N + 216; -- GNAT
Name_Keep_Names : constant Name_Id := N + 215; -- GNAT Name_Keep_Names : constant Name_Id := N + 217; -- GNAT
Name_Link_With : constant Name_Id := N + 216; -- GNAT Name_Link_With : constant Name_Id := N + 218; -- GNAT
Name_Linker_Alias : constant Name_Id := N + 217; -- GNAT Name_Linker_Alias : constant Name_Id := N + 219; -- GNAT
Name_Linker_Constructor : constant Name_Id := N + 218; -- GNAT Name_Linker_Constructor : constant Name_Id := N + 220; -- GNAT
Name_Linker_Destructor : constant Name_Id := N + 219; -- GNAT Name_Linker_Destructor : constant Name_Id := N + 221; -- GNAT
Name_Linker_Options : constant Name_Id := N + 220; Name_Linker_Options : constant Name_Id := N + 222;
Name_Linker_Section : constant Name_Id := N + 221; -- GNAT Name_Linker_Section : constant Name_Id := N + 223; -- GNAT
Name_List : constant Name_Id := N + 222; Name_List : constant Name_Id := N + 224;
Name_Machine_Attribute : constant Name_Id := N + 223; -- GNAT Name_Machine_Attribute : constant Name_Id := N + 225; -- GNAT
Name_Main : constant Name_Id := N + 224; -- GNAT Name_Main : constant Name_Id := N + 226; -- GNAT
Name_Main_Storage : constant Name_Id := N + 225; -- GNAT Name_Main_Storage : constant Name_Id := N + 227; -- GNAT
Name_Memory_Size : constant Name_Id := N + 226; -- Ada 83 Name_Memory_Size : constant Name_Id := N + 228; -- Ada 83
Name_No_Body : constant Name_Id := N + 227; -- GNAT Name_No_Body : constant Name_Id := N + 229; -- GNAT
Name_No_Return : constant Name_Id := N + 228; -- GNAT Name_No_Return : constant Name_Id := N + 230; -- GNAT
Name_Obsolescent : constant Name_Id := N + 229; -- GNAT Name_Obsolescent : constant Name_Id := N + 231; -- GNAT
Name_Optimize : constant Name_Id := N + 230; Name_Optimize : constant Name_Id := N + 232;
Name_Pack : constant Name_Id := N + 231; Name_Pack : constant Name_Id := N + 233;
Name_Page : constant Name_Id := N + 232; Name_Page : constant Name_Id := N + 234;
Name_Passive : constant Name_Id := N + 233; -- GNAT Name_Passive : constant Name_Id := N + 235; -- GNAT
Name_Preelaborable_Initialization : constant Name_Id := N + 234; -- Ada 05 Name_Preelaborable_Initialization : constant Name_Id := N + 236; -- Ada 05
Name_Preelaborate : constant Name_Id := N + 235; Name_Preelaborate : constant Name_Id := N + 237;
Name_Preelaborate_05 : constant Name_Id := N + 236; -- GNAT Name_Preelaborate_05 : constant Name_Id := N + 238; -- GNAT
-- Note: Priority is not in this list because its name matches the -- Note: Priority is not in this list because its name matches the
-- name of the corresponding attribute. However, it is included in the -- name of the corresponding attribute. However, it is included in the
...@@ -475,15 +476,15 @@ package Snames is ...@@ -475,15 +476,15 @@ package Snames is
-- and Check_Pragma_Id correctly recognize and process Priority. -- and Check_Pragma_Id correctly recognize and process Priority.
-- Priority is a standard Ada 95 pragma. -- Priority is a standard Ada 95 pragma.
Name_Psect_Object : constant Name_Id := N + 237; -- VMS Name_Psect_Object : constant Name_Id := N + 239; -- VMS
Name_Pure : constant Name_Id := N + 238; Name_Pure : constant Name_Id := N + 240;
Name_Pure_05 : constant Name_Id := N + 239; -- GNAT Name_Pure_05 : constant Name_Id := N + 241; -- GNAT
Name_Pure_Function : constant Name_Id := N + 240; -- GNAT Name_Pure_Function : constant Name_Id := N + 242; -- GNAT
Name_Remote_Call_Interface : constant Name_Id := N + 241; Name_Remote_Call_Interface : constant Name_Id := N + 243;
Name_Remote_Types : constant Name_Id := N + 242; Name_Remote_Types : constant Name_Id := N + 244;
Name_Share_Generic : constant Name_Id := N + 243; -- GNAT Name_Share_Generic : constant Name_Id := N + 245; -- GNAT
Name_Shared : constant Name_Id := N + 244; -- Ada 83 Name_Shared : constant Name_Id := N + 246; -- Ada 83
Name_Shared_Passive : constant Name_Id := N + 245; Name_Shared_Passive : constant Name_Id := N + 247;
-- Note: Storage_Size is not in this list because its name matches the -- Note: Storage_Size is not in this list because its name matches the
-- name of the corresponding attribute. However, it is included in the -- name of the corresponding attribute. However, it is included in the
...@@ -493,29 +494,29 @@ package Snames is ...@@ -493,29 +494,29 @@ package Snames is
-- Note: Storage_Unit is also omitted from the list because of a clash -- Note: Storage_Unit is also omitted from the list because of a clash
-- with an attribute name, and is treated similarly. -- with an attribute name, and is treated similarly.
Name_Source_Reference : constant Name_Id := N + 246; -- GNAT Name_Source_Reference : constant Name_Id := N + 248; -- GNAT
Name_Static_Elaboration_Desired : constant Name_Id := N + 247; -- GNAT Name_Static_Elaboration_Desired : constant Name_Id := N + 249; -- GNAT
Name_Stream_Convert : constant Name_Id := N + 248; -- GNAT Name_Stream_Convert : constant Name_Id := N + 250; -- GNAT
Name_Subtitle : constant Name_Id := N + 249; -- GNAT Name_Subtitle : constant Name_Id := N + 251; -- GNAT
Name_Suppress_All : constant Name_Id := N + 250; -- GNAT Name_Suppress_All : constant Name_Id := N + 252; -- GNAT
Name_Suppress_Debug_Info : constant Name_Id := N + 251; -- GNAT Name_Suppress_Debug_Info : constant Name_Id := N + 253; -- GNAT
Name_Suppress_Initialization : constant Name_Id := N + 252; -- GNAT Name_Suppress_Initialization : constant Name_Id := N + 254; -- GNAT
Name_System_Name : constant Name_Id := N + 253; -- Ada 83 Name_System_Name : constant Name_Id := N + 255; -- Ada 83
Name_Task_Info : constant Name_Id := N + 254; -- GNAT Name_Task_Info : constant Name_Id := N + 256; -- GNAT
Name_Task_Name : constant Name_Id := N + 255; -- GNAT Name_Task_Name : constant Name_Id := N + 257; -- GNAT
Name_Task_Storage : constant Name_Id := N + 256; -- VMS Name_Task_Storage : constant Name_Id := N + 258; -- VMS
Name_Time_Slice : constant Name_Id := N + 257; -- GNAT Name_Time_Slice : constant Name_Id := N + 259; -- GNAT
Name_Title : constant Name_Id := N + 258; -- GNAT Name_Title : constant Name_Id := N + 260; -- GNAT
Name_Unchecked_Union : constant Name_Id := N + 259; -- GNAT Name_Unchecked_Union : constant Name_Id := N + 261; -- GNAT
Name_Unimplemented_Unit : constant Name_Id := N + 260; -- GNAT Name_Unimplemented_Unit : constant Name_Id := N + 262; -- GNAT
Name_Universal_Aliasing : constant Name_Id := N + 261; -- GNAT Name_Universal_Aliasing : constant Name_Id := N + 263; -- GNAT
Name_Unreferenced : constant Name_Id := N + 262; -- GNAT Name_Unreferenced : constant Name_Id := N + 264; -- GNAT
Name_Unreferenced_Objects : constant Name_Id := N + 263; -- GNAT Name_Unreferenced_Objects : constant Name_Id := N + 265; -- GNAT
Name_Unreserve_All_Interrupts : constant Name_Id := N + 264; -- GNAT Name_Unreserve_All_Interrupts : constant Name_Id := N + 266; -- GNAT
Name_Volatile : constant Name_Id := N + 265; Name_Volatile : constant Name_Id := N + 267;
Name_Volatile_Components : constant Name_Id := N + 266; Name_Volatile_Components : constant Name_Id := N + 268;
Name_Weak_External : constant Name_Id := N + 267; -- GNAT Name_Weak_External : constant Name_Id := N + 269; -- GNAT
Last_Pragma_Name : constant Name_Id := N + 267; Last_Pragma_Name : constant Name_Id := N + 269;
-- Language convention names for pragma Convention/Export/Import/Interface -- Language convention names for pragma Convention/Export/Import/Interface
-- Note that Name_C is not included in this list, since it was already -- Note that Name_C is not included in this list, since it was already
...@@ -526,119 +527,119 @@ package Snames is ...@@ -526,119 +527,119 @@ package Snames is
-- Entry and Protected, this is because these conventions cannot be -- Entry and Protected, this is because these conventions cannot be
-- specified by a pragma. -- specified by a pragma.
First_Convention_Name : constant Name_Id := N + 268; First_Convention_Name : constant Name_Id := N + 270;
Name_Ada : constant Name_Id := N + 268; Name_Ada : constant Name_Id := N + 270;
Name_Assembler : constant Name_Id := N + 269; Name_Assembler : constant Name_Id := N + 271;
Name_CIL : constant Name_Id := N + 270; Name_CIL : constant Name_Id := N + 272;
Name_COBOL : constant Name_Id := N + 271; Name_COBOL : constant Name_Id := N + 273;
Name_CPP : constant Name_Id := N + 272; Name_CPP : constant Name_Id := N + 274;
Name_Fortran : constant Name_Id := N + 273; Name_Fortran : constant Name_Id := N + 275;
Name_Intrinsic : constant Name_Id := N + 274; Name_Intrinsic : constant Name_Id := N + 276;
Name_Java : constant Name_Id := N + 275; Name_Java : constant Name_Id := N + 277;
Name_Stdcall : constant Name_Id := N + 276; Name_Stdcall : constant Name_Id := N + 278;
Name_Stubbed : constant Name_Id := N + 277; Name_Stubbed : constant Name_Id := N + 279;
Last_Convention_Name : constant Name_Id := N + 277; Last_Convention_Name : constant Name_Id := N + 279;
-- The following names are preset as synonyms for Assembler -- The following names are preset as synonyms for Assembler
Name_Asm : constant Name_Id := N + 278; Name_Asm : constant Name_Id := N + 280;
Name_Assembly : constant Name_Id := N + 279; Name_Assembly : constant Name_Id := N + 281;
-- The following names are preset as synonyms for C -- The following names are preset as synonyms for C
Name_Default : constant Name_Id := N + 280; Name_Default : constant Name_Id := N + 282;
-- Name_Exernal (previously defined as pragma) -- Name_Exernal (previously defined as pragma)
-- The following names are preset as synonyms for CPP -- The following names are preset as synonyms for CPP
Name_C_Plus_Plus : constant Name_Id := N + 281; Name_C_Plus_Plus : constant Name_Id := N + 283;
-- The following names are present as synonyms for Stdcall -- The following names are present as synonyms for Stdcall
Name_DLL : constant Name_Id := N + 282; Name_DLL : constant Name_Id := N + 284;
Name_Win32 : constant Name_Id := N + 283; Name_Win32 : constant Name_Id := N + 285;
-- Other special names used in processing pragmas -- Other special names used in processing pragmas
Name_As_Is : constant Name_Id := N + 284; Name_As_Is : constant Name_Id := N + 286;
Name_Attribute_Name : constant Name_Id := N + 285; Name_Attribute_Name : constant Name_Id := N + 287;
Name_Body_File_Name : constant Name_Id := N + 286; Name_Body_File_Name : constant Name_Id := N + 288;
Name_Boolean_Entry_Barriers : constant Name_Id := N + 287; Name_Boolean_Entry_Barriers : constant Name_Id := N + 289;
Name_Check : constant Name_Id := N + 288; Name_Check : constant Name_Id := N + 290;
Name_Casing : constant Name_Id := N + 289; Name_Casing : constant Name_Id := N + 291;
Name_Code : constant Name_Id := N + 290; Name_Code : constant Name_Id := N + 292;
Name_Component : constant Name_Id := N + 291; Name_Component : constant Name_Id := N + 293;
Name_Component_Size_4 : constant Name_Id := N + 292; Name_Component_Size_4 : constant Name_Id := N + 294;
Name_Copy : constant Name_Id := N + 293; Name_Copy : constant Name_Id := N + 295;
Name_D_Float : constant Name_Id := N + 294; Name_D_Float : constant Name_Id := N + 296;
Name_Descriptor : constant Name_Id := N + 295; Name_Descriptor : constant Name_Id := N + 297;
Name_Dot_Replacement : constant Name_Id := N + 296; Name_Dot_Replacement : constant Name_Id := N + 298;
Name_Dynamic : constant Name_Id := N + 297; Name_Dynamic : constant Name_Id := N + 299;
Name_Entity : constant Name_Id := N + 298; Name_Entity : constant Name_Id := N + 300;
Name_Entry_Count : constant Name_Id := N + 299; Name_Entry_Count : constant Name_Id := N + 301;
Name_External_Name : constant Name_Id := N + 300; Name_External_Name : constant Name_Id := N + 302;
Name_First_Optional_Parameter : constant Name_Id := N + 301; Name_First_Optional_Parameter : constant Name_Id := N + 303;
Name_Form : constant Name_Id := N + 302; Name_Form : constant Name_Id := N + 304;
Name_G_Float : constant Name_Id := N + 303; Name_G_Float : constant Name_Id := N + 305;
Name_Gcc : constant Name_Id := N + 304; Name_Gcc : constant Name_Id := N + 306;
Name_Gnat : constant Name_Id := N + 305; Name_Gnat : constant Name_Id := N + 307;
Name_GPL : constant Name_Id := N + 306; Name_GPL : constant Name_Id := N + 308;
Name_IEEE_Float : constant Name_Id := N + 307; Name_IEEE_Float : constant Name_Id := N + 309;
Name_Ignore : constant Name_Id := N + 308; Name_Ignore : constant Name_Id := N + 310;
Name_Info : constant Name_Id := N + 309; Name_Info : constant Name_Id := N + 311;
Name_Internal : constant Name_Id := N + 310; Name_Internal : constant Name_Id := N + 312;
Name_Link_Name : constant Name_Id := N + 311; Name_Link_Name : constant Name_Id := N + 313;
Name_Lowercase : constant Name_Id := N + 312; Name_Lowercase : constant Name_Id := N + 314;
Name_Max_Entry_Queue_Depth : constant Name_Id := N + 313; Name_Max_Entry_Queue_Depth : constant Name_Id := N + 315;
Name_Max_Entry_Queue_Length : constant Name_Id := N + 314; Name_Max_Entry_Queue_Length : constant Name_Id := N + 316;
Name_Max_Size : constant Name_Id := N + 315; Name_Max_Size : constant Name_Id := N + 317;
Name_Mechanism : constant Name_Id := N + 316; Name_Mechanism : constant Name_Id := N + 318;
Name_Message : constant Name_Id := N + 317; Name_Message : constant Name_Id := N + 319;
Name_Mixedcase : constant Name_Id := N + 318; Name_Mixedcase : constant Name_Id := N + 320;
Name_Modified_GPL : constant Name_Id := N + 319; Name_Modified_GPL : constant Name_Id := N + 321;
Name_Name : constant Name_Id := N + 320; Name_Name : constant Name_Id := N + 322;
Name_NCA : constant Name_Id := N + 321; Name_NCA : constant Name_Id := N + 323;
Name_No : constant Name_Id := N + 322; Name_No : constant Name_Id := N + 324;
Name_No_Dependence : constant Name_Id := N + 323; Name_No_Dependence : constant Name_Id := N + 325;
Name_No_Dynamic_Attachment : constant Name_Id := N + 324; Name_No_Dynamic_Attachment : constant Name_Id := N + 326;
Name_No_Dynamic_Interrupts : constant Name_Id := N + 325; Name_No_Dynamic_Interrupts : constant Name_Id := N + 327;
Name_No_Requeue : constant Name_Id := N + 326; Name_No_Requeue : constant Name_Id := N + 328;
Name_No_Requeue_Statements : constant Name_Id := N + 327; Name_No_Requeue_Statements : constant Name_Id := N + 329;
Name_No_Task_Attributes : constant Name_Id := N + 328; Name_No_Task_Attributes : constant Name_Id := N + 330;
Name_No_Task_Attributes_Package : constant Name_Id := N + 329; Name_No_Task_Attributes_Package : constant Name_Id := N + 331;
Name_On : constant Name_Id := N + 330; Name_On : constant Name_Id := N + 332;
Name_Parameter_Types : constant Name_Id := N + 331; Name_Parameter_Types : constant Name_Id := N + 333;
Name_Reference : constant Name_Id := N + 332; Name_Reference : constant Name_Id := N + 334;
Name_Restricted : constant Name_Id := N + 333; Name_Restricted : constant Name_Id := N + 335;
Name_Result_Mechanism : constant Name_Id := N + 334; Name_Result_Mechanism : constant Name_Id := N + 336;
Name_Result_Type : constant Name_Id := N + 335; Name_Result_Type : constant Name_Id := N + 337;
Name_Runtime : constant Name_Id := N + 336; Name_Runtime : constant Name_Id := N + 338;
Name_SB : constant Name_Id := N + 337; Name_SB : constant Name_Id := N + 339;
Name_Secondary_Stack_Size : constant Name_Id := N + 338; Name_Secondary_Stack_Size : constant Name_Id := N + 340;
Name_Section : constant Name_Id := N + 339; Name_Section : constant Name_Id := N + 341;
Name_Semaphore : constant Name_Id := N + 340; Name_Semaphore : constant Name_Id := N + 342;
Name_Simple_Barriers : constant Name_Id := N + 341; Name_Simple_Barriers : constant Name_Id := N + 343;
Name_Spec_File_Name : constant Name_Id := N + 342; Name_Spec_File_Name : constant Name_Id := N + 344;
Name_State : constant Name_Id := N + 343; Name_State : constant Name_Id := N + 345;
Name_Static : constant Name_Id := N + 344; Name_Static : constant Name_Id := N + 346;
Name_Stack_Size : constant Name_Id := N + 345; Name_Stack_Size : constant Name_Id := N + 347;
Name_Subunit_File_Name : constant Name_Id := N + 346; Name_Subunit_File_Name : constant Name_Id := N + 348;
Name_Task_Stack_Size_Default : constant Name_Id := N + 347; Name_Task_Stack_Size_Default : constant Name_Id := N + 349;
Name_Task_Type : constant Name_Id := N + 348; Name_Task_Type : constant Name_Id := N + 350;
Name_Time_Slicing_Enabled : constant Name_Id := N + 349; Name_Time_Slicing_Enabled : constant Name_Id := N + 351;
Name_Top_Guard : constant Name_Id := N + 350; Name_Top_Guard : constant Name_Id := N + 352;
Name_UBA : constant Name_Id := N + 351; Name_UBA : constant Name_Id := N + 353;
Name_UBS : constant Name_Id := N + 352; Name_UBS : constant Name_Id := N + 354;
Name_UBSB : constant Name_Id := N + 353; Name_UBSB : constant Name_Id := N + 355;
Name_Unit_Name : constant Name_Id := N + 354; Name_Unit_Name : constant Name_Id := N + 356;
Name_Unknown : constant Name_Id := N + 355; Name_Unknown : constant Name_Id := N + 357;
Name_Unrestricted : constant Name_Id := N + 356; Name_Unrestricted : constant Name_Id := N + 358;
Name_Uppercase : constant Name_Id := N + 357; Name_Uppercase : constant Name_Id := N + 359;
Name_User : constant Name_Id := N + 358; Name_User : constant Name_Id := N + 360;
Name_VAX_Float : constant Name_Id := N + 359; Name_VAX_Float : constant Name_Id := N + 361;
Name_VMS : constant Name_Id := N + 360; Name_VMS : constant Name_Id := N + 362;
Name_Vtable_Ptr : constant Name_Id := N + 361; Name_Vtable_Ptr : constant Name_Id := N + 363;
Name_Working_Storage : constant Name_Id := N + 362; Name_Working_Storage : constant Name_Id := N + 364;
-- Names of recognized attributes. The entries with the comment "Ada 83" -- Names of recognized attributes. The entries with the comment "Ada 83"
-- are attributes that are defined in Ada 83, but not in Ada 95. These -- are attributes that are defined in Ada 83, but not in Ada 95. These
...@@ -652,168 +653,169 @@ package Snames is ...@@ -652,168 +653,169 @@ package Snames is
-- The entries marked VMS are recognized only in OpenVMS implementations -- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts. -- of GNAT, and are treated as illegal in all other contexts.
First_Attribute_Name : constant Name_Id := N + 363; First_Attribute_Name : constant Name_Id := N + 365;
Name_Abort_Signal : constant Name_Id := N + 363; -- GNAT Name_Abort_Signal : constant Name_Id := N + 365; -- GNAT
Name_Access : constant Name_Id := N + 364; Name_Access : constant Name_Id := N + 366;
Name_Address : constant Name_Id := N + 365; Name_Address : constant Name_Id := N + 367;
Name_Address_Size : constant Name_Id := N + 366; -- GNAT Name_Address_Size : constant Name_Id := N + 368; -- GNAT
Name_Aft : constant Name_Id := N + 367; Name_Aft : constant Name_Id := N + 369;
Name_Alignment : constant Name_Id := N + 368; Name_Alignment : constant Name_Id := N + 370;
Name_Asm_Input : constant Name_Id := N + 369; -- GNAT Name_Asm_Input : constant Name_Id := N + 371; -- GNAT
Name_Asm_Output : constant Name_Id := N + 370; -- GNAT Name_Asm_Output : constant Name_Id := N + 372; -- GNAT
Name_AST_Entry : constant Name_Id := N + 371; -- VMS Name_AST_Entry : constant Name_Id := N + 373; -- VMS
Name_Bit : constant Name_Id := N + 372; -- GNAT Name_Bit : constant Name_Id := N + 374; -- GNAT
Name_Bit_Order : constant Name_Id := N + 373; Name_Bit_Order : constant Name_Id := N + 375;
Name_Bit_Position : constant Name_Id := N + 374; -- GNAT Name_Bit_Position : constant Name_Id := N + 376; -- GNAT
Name_Body_Version : constant Name_Id := N + 375; Name_Body_Version : constant Name_Id := N + 377;
Name_Callable : constant Name_Id := N + 376; Name_Callable : constant Name_Id := N + 378;
Name_Caller : constant Name_Id := N + 377; Name_Caller : constant Name_Id := N + 379;
Name_Code_Address : constant Name_Id := N + 378; -- GNAT Name_Code_Address : constant Name_Id := N + 380; -- GNAT
Name_Component_Size : constant Name_Id := N + 379; Name_Component_Size : constant Name_Id := N + 381;
Name_Compose : constant Name_Id := N + 380; Name_Compose : constant Name_Id := N + 382;
Name_Constrained : constant Name_Id := N + 381; Name_Constrained : constant Name_Id := N + 383;
Name_Count : constant Name_Id := N + 382; Name_Count : constant Name_Id := N + 384;
Name_Default_Bit_Order : constant Name_Id := N + 383; -- GNAT Name_Default_Bit_Order : constant Name_Id := N + 385; -- GNAT
Name_Definite : constant Name_Id := N + 384; Name_Definite : constant Name_Id := N + 386;
Name_Delta : constant Name_Id := N + 385; Name_Delta : constant Name_Id := N + 387;
Name_Denorm : constant Name_Id := N + 386; Name_Denorm : constant Name_Id := N + 388;
Name_Digits : constant Name_Id := N + 387; Name_Digits : constant Name_Id := N + 389;
Name_Elaborated : constant Name_Id := N + 388; -- GNAT Name_Elaborated : constant Name_Id := N + 390; -- GNAT
Name_Emax : constant Name_Id := N + 389; -- Ada 83 Name_Emax : constant Name_Id := N + 391; -- Ada 83
Name_Enum_Rep : constant Name_Id := N + 390; -- GNAT Name_Enabled : constant Name_Id := N + 392; -- GNAT
Name_Epsilon : constant Name_Id := N + 391; -- Ada 83 Name_Enum_Rep : constant Name_Id := N + 393; -- GNAT
Name_Exponent : constant Name_Id := N + 392; Name_Epsilon : constant Name_Id := N + 394; -- Ada 83
Name_External_Tag : constant Name_Id := N + 393; Name_Exponent : constant Name_Id := N + 395;
Name_First : constant Name_Id := N + 394; Name_External_Tag : constant Name_Id := N + 396;
Name_First_Bit : constant Name_Id := N + 395; Name_First : constant Name_Id := N + 397;
Name_Fixed_Value : constant Name_Id := N + 396; -- GNAT Name_First_Bit : constant Name_Id := N + 398;
Name_Fore : constant Name_Id := N + 397; Name_Fixed_Value : constant Name_Id := N + 399; -- GNAT
Name_Has_Access_Values : constant Name_Id := N + 398; -- GNAT Name_Fore : constant Name_Id := N + 400;
Name_Has_Discriminants : constant Name_Id := N + 399; -- GNAT Name_Has_Access_Values : constant Name_Id := N + 401; -- GNAT
Name_Identity : constant Name_Id := N + 400; Name_Has_Discriminants : constant Name_Id := N + 402; -- GNAT
Name_Img : constant Name_Id := N + 401; -- GNAT Name_Identity : constant Name_Id := N + 403;
Name_Integer_Value : constant Name_Id := N + 402; -- GNAT Name_Img : constant Name_Id := N + 404; -- GNAT
Name_Large : constant Name_Id := N + 403; -- Ada 83 Name_Integer_Value : constant Name_Id := N + 405; -- GNAT
Name_Last : constant Name_Id := N + 404; Name_Large : constant Name_Id := N + 406; -- Ada 83
Name_Last_Bit : constant Name_Id := N + 405; Name_Last : constant Name_Id := N + 407;
Name_Leading_Part : constant Name_Id := N + 406; Name_Last_Bit : constant Name_Id := N + 408;
Name_Length : constant Name_Id := N + 407; Name_Leading_Part : constant Name_Id := N + 409;
Name_Machine_Emax : constant Name_Id := N + 408; Name_Length : constant Name_Id := N + 410;
Name_Machine_Emin : constant Name_Id := N + 409; Name_Machine_Emax : constant Name_Id := N + 411;
Name_Machine_Mantissa : constant Name_Id := N + 410; Name_Machine_Emin : constant Name_Id := N + 412;
Name_Machine_Overflows : constant Name_Id := N + 411; Name_Machine_Mantissa : constant Name_Id := N + 413;
Name_Machine_Radix : constant Name_Id := N + 412; Name_Machine_Overflows : constant Name_Id := N + 414;
Name_Machine_Rounding : constant Name_Id := N + 413; -- Ada 05 Name_Machine_Radix : constant Name_Id := N + 415;
Name_Machine_Rounds : constant Name_Id := N + 414; Name_Machine_Rounding : constant Name_Id := N + 416; -- Ada 05
Name_Machine_Size : constant Name_Id := N + 415; -- GNAT Name_Machine_Rounds : constant Name_Id := N + 417;
Name_Mantissa : constant Name_Id := N + 416; -- Ada 83 Name_Machine_Size : constant Name_Id := N + 418; -- GNAT
Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 417; Name_Mantissa : constant Name_Id := N + 419; -- Ada 83
Name_Maximum_Alignment : constant Name_Id := N + 418; -- GNAT Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 420;
Name_Mechanism_Code : constant Name_Id := N + 419; -- GNAT Name_Maximum_Alignment : constant Name_Id := N + 421; -- GNAT
Name_Mod : constant Name_Id := N + 420; Name_Mechanism_Code : constant Name_Id := N + 422; -- GNAT
Name_Model_Emin : constant Name_Id := N + 421; Name_Mod : constant Name_Id := N + 423; -- Ada 05
Name_Model_Epsilon : constant Name_Id := N + 422; Name_Model_Emin : constant Name_Id := N + 424;
Name_Model_Mantissa : constant Name_Id := N + 423; Name_Model_Epsilon : constant Name_Id := N + 425;
Name_Model_Small : constant Name_Id := N + 424; Name_Model_Mantissa : constant Name_Id := N + 426;
Name_Modulus : constant Name_Id := N + 425; Name_Model_Small : constant Name_Id := N + 427;
Name_Null_Parameter : constant Name_Id := N + 426; -- GNAT Name_Modulus : constant Name_Id := N + 428;
Name_Object_Size : constant Name_Id := N + 427; -- GNAT Name_Null_Parameter : constant Name_Id := N + 429; -- GNAT
Name_Partition_ID : constant Name_Id := N + 428; Name_Object_Size : constant Name_Id := N + 430; -- GNAT
Name_Passed_By_Reference : constant Name_Id := N + 429; -- GNAT Name_Partition_ID : constant Name_Id := N + 431;
Name_Pool_Address : constant Name_Id := N + 430; Name_Passed_By_Reference : constant Name_Id := N + 432; -- GNAT
Name_Pos : constant Name_Id := N + 431; Name_Pool_Address : constant Name_Id := N + 433;
Name_Position : constant Name_Id := N + 432; Name_Pos : constant Name_Id := N + 434;
Name_Priority : constant Name_Id := N + 433; -- Ada 05 Name_Position : constant Name_Id := N + 435;
Name_Range : constant Name_Id := N + 434; Name_Priority : constant Name_Id := N + 436; -- Ada 05
Name_Range_Length : constant Name_Id := N + 435; -- GNAT Name_Range : constant Name_Id := N + 437;
Name_Round : constant Name_Id := N + 436; Name_Range_Length : constant Name_Id := N + 438; -- GNAT
Name_Safe_Emax : constant Name_Id := N + 437; -- Ada 83 Name_Round : constant Name_Id := N + 439;
Name_Safe_First : constant Name_Id := N + 438; Name_Safe_Emax : constant Name_Id := N + 440; -- Ada 83
Name_Safe_Large : constant Name_Id := N + 439; -- Ada 83 Name_Safe_First : constant Name_Id := N + 441;
Name_Safe_Last : constant Name_Id := N + 440; Name_Safe_Large : constant Name_Id := N + 442; -- Ada 83
Name_Safe_Small : constant Name_Id := N + 441; -- Ada 83 Name_Safe_Last : constant Name_Id := N + 443;
Name_Scale : constant Name_Id := N + 442; Name_Safe_Small : constant Name_Id := N + 444; -- Ada 83
Name_Scaling : constant Name_Id := N + 443; Name_Scale : constant Name_Id := N + 445;
Name_Signed_Zeros : constant Name_Id := N + 444; Name_Scaling : constant Name_Id := N + 446;
Name_Size : constant Name_Id := N + 445; Name_Signed_Zeros : constant Name_Id := N + 447;
Name_Small : constant Name_Id := N + 446; Name_Size : constant Name_Id := N + 448;
Name_Storage_Size : constant Name_Id := N + 447; Name_Small : constant Name_Id := N + 449;
Name_Storage_Unit : constant Name_Id := N + 448; -- GNAT Name_Storage_Size : constant Name_Id := N + 450;
Name_Stream_Size : constant Name_Id := N + 449; -- Ada 05 Name_Storage_Unit : constant Name_Id := N + 451; -- GNAT
Name_Tag : constant Name_Id := N + 450; Name_Stream_Size : constant Name_Id := N + 452; -- Ada 05
Name_Target_Name : constant Name_Id := N + 451; -- GNAT Name_Tag : constant Name_Id := N + 453;
Name_Terminated : constant Name_Id := N + 452; Name_Target_Name : constant Name_Id := N + 454; -- GNAT
Name_To_Address : constant Name_Id := N + 453; -- GNAT Name_Terminated : constant Name_Id := N + 455;
Name_Type_Class : constant Name_Id := N + 454; -- GNAT Name_To_Address : constant Name_Id := N + 456; -- GNAT
Name_UET_Address : constant Name_Id := N + 455; -- GNAT Name_Type_Class : constant Name_Id := N + 457; -- GNAT
Name_Unbiased_Rounding : constant Name_Id := N + 456; Name_UET_Address : constant Name_Id := N + 458; -- GNAT
Name_Unchecked_Access : constant Name_Id := N + 457; Name_Unbiased_Rounding : constant Name_Id := N + 459;
Name_Unconstrained_Array : constant Name_Id := N + 458; Name_Unchecked_Access : constant Name_Id := N + 460;
Name_Universal_Literal_String : constant Name_Id := N + 459; -- GNAT Name_Unconstrained_Array : constant Name_Id := N + 461;
Name_Unrestricted_Access : constant Name_Id := N + 460; -- GNAT Name_Universal_Literal_String : constant Name_Id := N + 462; -- GNAT
Name_VADS_Size : constant Name_Id := N + 461; -- GNAT Name_Unrestricted_Access : constant Name_Id := N + 463; -- GNAT
Name_Val : constant Name_Id := N + 462; Name_VADS_Size : constant Name_Id := N + 464; -- GNAT
Name_Valid : constant Name_Id := N + 463; Name_Val : constant Name_Id := N + 465;
Name_Value_Size : constant Name_Id := N + 464; -- GNAT Name_Valid : constant Name_Id := N + 466;
Name_Version : constant Name_Id := N + 465; Name_Value_Size : constant Name_Id := N + 467; -- GNAT
Name_Wchar_T_Size : constant Name_Id := N + 466; -- GNAT Name_Version : constant Name_Id := N + 468;
Name_Wide_Wide_Width : constant Name_Id := N + 467; -- Ada 05 Name_Wchar_T_Size : constant Name_Id := N + 469; -- GNAT
Name_Wide_Width : constant Name_Id := N + 468; Name_Wide_Wide_Width : constant Name_Id := N + 470; -- Ada 05
Name_Width : constant Name_Id := N + 469; Name_Wide_Width : constant Name_Id := N + 471;
Name_Word_Size : constant Name_Id := N + 470; -- GNAT Name_Width : constant Name_Id := N + 472;
Name_Word_Size : constant Name_Id := N + 473; -- GNAT
-- Attributes that designate attributes returning renamable functions, -- Attributes that designate attributes returning renamable functions,
-- i.e. functions that return other than a universal value and that -- i.e. functions that return other than a universal value and that
-- have non-universal arguments. -- have non-universal arguments.
First_Renamable_Function_Attribute : constant Name_Id := N + 471; First_Renamable_Function_Attribute : constant Name_Id := N + 474;
Name_Adjacent : constant Name_Id := N + 471; Name_Adjacent : constant Name_Id := N + 474;
Name_Ceiling : constant Name_Id := N + 472; Name_Ceiling : constant Name_Id := N + 475;
Name_Copy_Sign : constant Name_Id := N + 473; Name_Copy_Sign : constant Name_Id := N + 476;
Name_Floor : constant Name_Id := N + 474; Name_Floor : constant Name_Id := N + 477;
Name_Fraction : constant Name_Id := N + 475; Name_Fraction : constant Name_Id := N + 478;
Name_Image : constant Name_Id := N + 476; Name_Image : constant Name_Id := N + 479;
Name_Input : constant Name_Id := N + 477; Name_Input : constant Name_Id := N + 480;
Name_Machine : constant Name_Id := N + 478; Name_Machine : constant Name_Id := N + 481;
Name_Max : constant Name_Id := N + 479; Name_Max : constant Name_Id := N + 482;
Name_Min : constant Name_Id := N + 480; Name_Min : constant Name_Id := N + 483;
Name_Model : constant Name_Id := N + 481; Name_Model : constant Name_Id := N + 484;
Name_Pred : constant Name_Id := N + 482; Name_Pred : constant Name_Id := N + 485;
Name_Remainder : constant Name_Id := N + 483; Name_Remainder : constant Name_Id := N + 486;
Name_Rounding : constant Name_Id := N + 484; Name_Rounding : constant Name_Id := N + 487;
Name_Succ : constant Name_Id := N + 485; Name_Succ : constant Name_Id := N + 488;
Name_Truncation : constant Name_Id := N + 486; Name_Truncation : constant Name_Id := N + 489;
Name_Value : constant Name_Id := N + 487; Name_Value : constant Name_Id := N + 490;
Name_Wide_Image : constant Name_Id := N + 488; Name_Wide_Image : constant Name_Id := N + 491;
Name_Wide_Wide_Image : constant Name_Id := N + 489; Name_Wide_Wide_Image : constant Name_Id := N + 492;
Name_Wide_Value : constant Name_Id := N + 490; Name_Wide_Value : constant Name_Id := N + 493;
Name_Wide_Wide_Value : constant Name_Id := N + 491; Name_Wide_Wide_Value : constant Name_Id := N + 494;
Last_Renamable_Function_Attribute : constant Name_Id := N + 491; Last_Renamable_Function_Attribute : constant Name_Id := N + 494;
-- Attributes that designate procedures -- Attributes that designate procedures
First_Procedure_Attribute : constant Name_Id := N + 492; First_Procedure_Attribute : constant Name_Id := N + 495;
Name_Output : constant Name_Id := N + 492; Name_Output : constant Name_Id := N + 495;
Name_Read : constant Name_Id := N + 493; Name_Read : constant Name_Id := N + 496;
Name_Write : constant Name_Id := N + 494; Name_Write : constant Name_Id := N + 497;
Last_Procedure_Attribute : constant Name_Id := N + 494; Last_Procedure_Attribute : constant Name_Id := N + 497;
-- Remaining attributes are ones that return entities -- Remaining attributes are ones that return entities
First_Entity_Attribute_Name : constant Name_Id := N + 495; First_Entity_Attribute_Name : constant Name_Id := N + 498;
Name_Elab_Body : constant Name_Id := N + 495; -- GNAT Name_Elab_Body : constant Name_Id := N + 498; -- GNAT
Name_Elab_Spec : constant Name_Id := N + 496; -- GNAT Name_Elab_Spec : constant Name_Id := N + 499; -- GNAT
Name_Storage_Pool : constant Name_Id := N + 497; Name_Storage_Pool : constant Name_Id := N + 500;
-- These attributes are the ones that return types -- These attributes are the ones that return types
First_Type_Attribute_Name : constant Name_Id := N + 498; First_Type_Attribute_Name : constant Name_Id := N + 501;
Name_Base : constant Name_Id := N + 498; Name_Base : constant Name_Id := N + 501;
Name_Class : constant Name_Id := N + 499; Name_Class : constant Name_Id := N + 502;
Name_Stub_Type : constant Name_Id := N + 500; Name_Stub_Type : constant Name_Id := N + 503;
Last_Type_Attribute_Name : constant Name_Id := N + 500; Last_Type_Attribute_Name : constant Name_Id := N + 503;
Last_Entity_Attribute_Name : constant Name_Id := N + 500; Last_Entity_Attribute_Name : constant Name_Id := N + 503;
Last_Attribute_Name : constant Name_Id := N + 500; Last_Attribute_Name : constant Name_Id := N + 503;
-- Names of recognized locking policy identifiers -- Names of recognized locking policy identifiers
...@@ -821,10 +823,10 @@ package Snames is ...@@ -821,10 +823,10 @@ package Snames is
-- name (e.g. C for Ceiling_Locking). If new policy names are added, -- name (e.g. C for Ceiling_Locking). If new policy names are added,
-- the first character must be distinct. -- the first character must be distinct.
First_Locking_Policy_Name : constant Name_Id := N + 501; First_Locking_Policy_Name : constant Name_Id := N + 504;
Name_Ceiling_Locking : constant Name_Id := N + 501; Name_Ceiling_Locking : constant Name_Id := N + 504;
Name_Inheritance_Locking : constant Name_Id := N + 502; Name_Inheritance_Locking : constant Name_Id := N + 505;
Last_Locking_Policy_Name : constant Name_Id := N + 502; Last_Locking_Policy_Name : constant Name_Id := N + 505;
-- Names of recognized queuing policy identifiers -- Names of recognized queuing policy identifiers
...@@ -832,10 +834,10 @@ package Snames is ...@@ -832,10 +834,10 @@ package Snames is
-- name (e.g. F for FIFO_Queuing). If new policy names are added, -- name (e.g. F for FIFO_Queuing). If new policy names are added,
-- the first character must be distinct. -- the first character must be distinct.
First_Queuing_Policy_Name : constant Name_Id := N + 503; First_Queuing_Policy_Name : constant Name_Id := N + 506;
Name_FIFO_Queuing : constant Name_Id := N + 503; Name_FIFO_Queuing : constant Name_Id := N + 506;
Name_Priority_Queuing : constant Name_Id := N + 504; Name_Priority_Queuing : constant Name_Id := N + 507;
Last_Queuing_Policy_Name : constant Name_Id := N + 504; Last_Queuing_Policy_Name : constant Name_Id := N + 507;
-- Names of recognized task dispatching policy identifiers -- Names of recognized task dispatching policy identifiers
...@@ -843,276 +845,269 @@ package Snames is ...@@ -843,276 +845,269 @@ package Snames is
-- name (e.g. F for FIFO_Within_Priorities). If new policy names -- name (e.g. F for FIFO_Within_Priorities). If new policy names
-- are added, the first character must be distinct. -- are added, the first character must be distinct.
First_Task_Dispatching_Policy_Name : constant Name_Id := N + 505; First_Task_Dispatching_Policy_Name : constant Name_Id := N + 508;
Name_EDF_Across_Priorities : constant Name_Id := N + 505; Name_EDF_Across_Priorities : constant Name_Id := N + 508;
Name_FIFO_Within_Priorities : constant Name_Id := N + 506; Name_FIFO_Within_Priorities : constant Name_Id := N + 509;
Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 507; Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 510;
Name_Round_Robin_Within_Priorities : constant Name_Id := N + 508; Name_Round_Robin_Within_Priorities : constant Name_Id := N + 511;
Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 508; Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 511;
-- Names of recognized checks for pragma Suppress -- Names of recognized checks for pragma Suppress
First_Check_Name : constant Name_Id := N + 509; First_Check_Name : constant Name_Id := N + 512;
Name_Access_Check : constant Name_Id := N + 509; Name_Access_Check : constant Name_Id := N + 512;
Name_Accessibility_Check : constant Name_Id := N + 510; Name_Accessibility_Check : constant Name_Id := N + 513;
Name_Alignment_Check : constant Name_Id := N + 511; Name_Alignment_Check : constant Name_Id := N + 514; -- GNAT
Name_Discriminant_Check : constant Name_Id := N + 512; Name_Discriminant_Check : constant Name_Id := N + 515;
Name_Division_Check : constant Name_Id := N + 513; Name_Division_Check : constant Name_Id := N + 516;
Name_Elaboration_Check : constant Name_Id := N + 514; Name_Elaboration_Check : constant Name_Id := N + 517;
Name_Index_Check : constant Name_Id := N + 515; Name_Index_Check : constant Name_Id := N + 518;
Name_Length_Check : constant Name_Id := N + 516; Name_Length_Check : constant Name_Id := N + 519;
Name_Overflow_Check : constant Name_Id := N + 517; Name_Overflow_Check : constant Name_Id := N + 520;
Name_Range_Check : constant Name_Id := N + 518; Name_Range_Check : constant Name_Id := N + 521;
Name_Storage_Check : constant Name_Id := N + 519; Name_Storage_Check : constant Name_Id := N + 522;
Name_Tag_Check : constant Name_Id := N + 520; Name_Tag_Check : constant Name_Id := N + 523;
Name_Validity_Check : constant Name_Id := N + 521; Name_Validity_Check : constant Name_Id := N + 524; -- GNAT
Name_All_Checks : constant Name_Id := N + 522; Name_All_Checks : constant Name_Id := N + 525;
Last_Check_Name : constant Name_Id := N + 522; Last_Check_Name : constant Name_Id := N + 525;
-- Names corresponding to reserved keywords, excluding those already -- Names corresponding to reserved keywords, excluding those already
-- declared in the attribute list (Access, Delta, Digits, Mod, Range). -- declared in the attribute list (Access, Delta, Digits, Mod, Range).
Name_Abort : constant Name_Id := N + 523; Name_Abort : constant Name_Id := N + 526;
Name_Abs : constant Name_Id := N + 524; Name_Abs : constant Name_Id := N + 527;
Name_Accept : constant Name_Id := N + 525; Name_Accept : constant Name_Id := N + 528;
Name_And : constant Name_Id := N + 526; Name_And : constant Name_Id := N + 529;
Name_All : constant Name_Id := N + 527; Name_All : constant Name_Id := N + 530;
Name_Array : constant Name_Id := N + 528; Name_Array : constant Name_Id := N + 531;
Name_At : constant Name_Id := N + 529; Name_At : constant Name_Id := N + 532;
Name_Begin : constant Name_Id := N + 530; Name_Begin : constant Name_Id := N + 533;
Name_Body : constant Name_Id := N + 531; Name_Body : constant Name_Id := N + 534;
Name_Case : constant Name_Id := N + 532; Name_Case : constant Name_Id := N + 535;
Name_Constant : constant Name_Id := N + 533; Name_Constant : constant Name_Id := N + 536;
Name_Declare : constant Name_Id := N + 534; Name_Declare : constant Name_Id := N + 537;
Name_Delay : constant Name_Id := N + 535; Name_Delay : constant Name_Id := N + 538;
Name_Do : constant Name_Id := N + 536; Name_Do : constant Name_Id := N + 539;
Name_Else : constant Name_Id := N + 537; Name_Else : constant Name_Id := N + 540;
Name_Elsif : constant Name_Id := N + 538; Name_Elsif : constant Name_Id := N + 541;
Name_End : constant Name_Id := N + 539; Name_End : constant Name_Id := N + 542;
Name_Entry : constant Name_Id := N + 540; Name_Entry : constant Name_Id := N + 543;
Name_Exception : constant Name_Id := N + 541; Name_Exception : constant Name_Id := N + 544;
Name_Exit : constant Name_Id := N + 542; Name_Exit : constant Name_Id := N + 545;
Name_For : constant Name_Id := N + 543; Name_For : constant Name_Id := N + 546;
Name_Function : constant Name_Id := N + 544; Name_Function : constant Name_Id := N + 547;
Name_Generic : constant Name_Id := N + 545; Name_Generic : constant Name_Id := N + 548;
Name_Goto : constant Name_Id := N + 546; Name_Goto : constant Name_Id := N + 549;
Name_If : constant Name_Id := N + 547; Name_If : constant Name_Id := N + 550;
Name_In : constant Name_Id := N + 548; Name_In : constant Name_Id := N + 551;
Name_Is : constant Name_Id := N + 549; Name_Is : constant Name_Id := N + 552;
Name_Limited : constant Name_Id := N + 550; Name_Limited : constant Name_Id := N + 553;
Name_Loop : constant Name_Id := N + 551; Name_Loop : constant Name_Id := N + 554;
Name_New : constant Name_Id := N + 552; Name_New : constant Name_Id := N + 555;
Name_Not : constant Name_Id := N + 553; Name_Not : constant Name_Id := N + 556;
Name_Null : constant Name_Id := N + 554; Name_Null : constant Name_Id := N + 557;
Name_Of : constant Name_Id := N + 555; Name_Of : constant Name_Id := N + 558;
Name_Or : constant Name_Id := N + 556; Name_Or : constant Name_Id := N + 559;
Name_Others : constant Name_Id := N + 557; Name_Others : constant Name_Id := N + 560;
Name_Out : constant Name_Id := N + 558; Name_Out : constant Name_Id := N + 561;
Name_Package : constant Name_Id := N + 559; Name_Package : constant Name_Id := N + 562;
Name_Pragma : constant Name_Id := N + 560; Name_Pragma : constant Name_Id := N + 563;
Name_Private : constant Name_Id := N + 561; Name_Private : constant Name_Id := N + 564;
Name_Procedure : constant Name_Id := N + 562; Name_Procedure : constant Name_Id := N + 565;
Name_Raise : constant Name_Id := N + 563; Name_Raise : constant Name_Id := N + 566;
Name_Record : constant Name_Id := N + 564; Name_Record : constant Name_Id := N + 567;
Name_Rem : constant Name_Id := N + 565; Name_Rem : constant Name_Id := N + 568;
Name_Renames : constant Name_Id := N + 566; Name_Renames : constant Name_Id := N + 569;
Name_Return : constant Name_Id := N + 567; Name_Return : constant Name_Id := N + 570;
Name_Reverse : constant Name_Id := N + 568; Name_Reverse : constant Name_Id := N + 571;
Name_Select : constant Name_Id := N + 569; Name_Select : constant Name_Id := N + 572;
Name_Separate : constant Name_Id := N + 570; Name_Separate : constant Name_Id := N + 573;
Name_Subtype : constant Name_Id := N + 571; Name_Subtype : constant Name_Id := N + 574;
Name_Task : constant Name_Id := N + 572; Name_Task : constant Name_Id := N + 575;
Name_Terminate : constant Name_Id := N + 573; Name_Terminate : constant Name_Id := N + 576;
Name_Then : constant Name_Id := N + 574; Name_Then : constant Name_Id := N + 577;
Name_Type : constant Name_Id := N + 575; Name_Type : constant Name_Id := N + 578;
Name_Use : constant Name_Id := N + 576; Name_Use : constant Name_Id := N + 579;
Name_When : constant Name_Id := N + 577; Name_When : constant Name_Id := N + 580;
Name_While : constant Name_Id := N + 578; Name_While : constant Name_Id := N + 581;
Name_With : constant Name_Id := N + 579; Name_With : constant Name_Id := N + 582;
Name_Xor : constant Name_Id := N + 580; Name_Xor : constant Name_Id := N + 583;
-- Names of intrinsic subprograms -- Names of intrinsic subprograms
-- Note: Asm is missing from this list, since Asm is a legitimate -- Note: Asm is missing from this list, since Asm is a legitimate
-- convention name. So is To_Adress, which is a GNAT attribute. -- convention name. So is To_Adress, which is a GNAT attribute.
First_Intrinsic_Name : constant Name_Id := N + 581; First_Intrinsic_Name : constant Name_Id := N + 584;
Name_Divide : constant Name_Id := N + 581; Name_Divide : constant Name_Id := N + 584;
Name_Enclosing_Entity : constant Name_Id := N + 582; Name_Enclosing_Entity : constant Name_Id := N + 585;
Name_Exception_Information : constant Name_Id := N + 583; Name_Exception_Information : constant Name_Id := N + 586;
Name_Exception_Message : constant Name_Id := N + 584; Name_Exception_Message : constant Name_Id := N + 587;
Name_Exception_Name : constant Name_Id := N + 585; Name_Exception_Name : constant Name_Id := N + 588;
Name_File : constant Name_Id := N + 586; Name_File : constant Name_Id := N + 589;
Name_Generic_Dispatching_Constructor : constant Name_Id := N + 587; Name_Generic_Dispatching_Constructor : constant Name_Id := N + 590;
Name_Import_Address : constant Name_Id := N + 588; Name_Import_Address : constant Name_Id := N + 591;
Name_Import_Largest_Value : constant Name_Id := N + 589; Name_Import_Largest_Value : constant Name_Id := N + 592;
Name_Import_Value : constant Name_Id := N + 590; Name_Import_Value : constant Name_Id := N + 593;
Name_Is_Negative : constant Name_Id := N + 591; Name_Is_Negative : constant Name_Id := N + 594;
Name_Line : constant Name_Id := N + 592; Name_Line : constant Name_Id := N + 595;
Name_Rotate_Left : constant Name_Id := N + 593; Name_Rotate_Left : constant Name_Id := N + 596;
Name_Rotate_Right : constant Name_Id := N + 594; Name_Rotate_Right : constant Name_Id := N + 597;
Name_Shift_Left : constant Name_Id := N + 595; Name_Shift_Left : constant Name_Id := N + 598;
Name_Shift_Right : constant Name_Id := N + 596; Name_Shift_Right : constant Name_Id := N + 599;
Name_Shift_Right_Arithmetic : constant Name_Id := N + 597; Name_Shift_Right_Arithmetic : constant Name_Id := N + 600;
Name_Source_Location : constant Name_Id := N + 598; Name_Source_Location : constant Name_Id := N + 601;
Name_Unchecked_Conversion : constant Name_Id := N + 599; Name_Unchecked_Conversion : constant Name_Id := N + 602;
Name_Unchecked_Deallocation : constant Name_Id := N + 600; Name_Unchecked_Deallocation : constant Name_Id := N + 603;
Name_To_Pointer : constant Name_Id := N + 601; Name_To_Pointer : constant Name_Id := N + 604;
Last_Intrinsic_Name : constant Name_Id := N + 601; Last_Intrinsic_Name : constant Name_Id := N + 604;
-- Names used in processing intrinsic calls -- Names used in processing intrinsic calls
Name_Free : constant Name_Id := N + 602; Name_Free : constant Name_Id := N + 605;
-- Reserved words used only in Ada 95 -- Reserved words used only in Ada 95
First_95_Reserved_Word : constant Name_Id := N + 603; First_95_Reserved_Word : constant Name_Id := N + 606;
Name_Abstract : constant Name_Id := N + 603; Name_Abstract : constant Name_Id := N + 606;
Name_Aliased : constant Name_Id := N + 604; Name_Aliased : constant Name_Id := N + 607;
Name_Protected : constant Name_Id := N + 605; Name_Protected : constant Name_Id := N + 608;
Name_Until : constant Name_Id := N + 606; Name_Until : constant Name_Id := N + 609;
Name_Requeue : constant Name_Id := N + 607; Name_Requeue : constant Name_Id := N + 610;
Name_Tagged : constant Name_Id := N + 608; Name_Tagged : constant Name_Id := N + 611;
Last_95_Reserved_Word : constant Name_Id := N + 608; Last_95_Reserved_Word : constant Name_Id := N + 611;
subtype Ada_95_Reserved_Words is subtype Ada_95_Reserved_Words is
Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word; Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
-- Miscellaneous names used in semantic checking -- Miscellaneous names used in semantic checking
Name_Raise_Exception : constant Name_Id := N + 609; Name_Raise_Exception : constant Name_Id := N + 612;
-- Additional reserved words and identifiers used in GNAT Project Files -- Additional reserved words and identifiers used in GNAT Project Files
-- Note that Name_External is already previously declared -- Note that Name_External is already previously declared
Name_Ada_Roots : constant Name_Id := N + 610; Name_Ada_Roots : constant Name_Id := N + 613;
Name_Archive_Builder : constant Name_Id := N + 611; Name_Archive_Builder : constant Name_Id := N + 614;
Name_Archive_Indexer : constant Name_Id := N + 612; Name_Archive_Indexer : constant Name_Id := N + 615;
Name_Archive_Suffix : constant Name_Id := N + 613; Name_Archive_Suffix : constant Name_Id := N + 616;
Name_Binder : constant Name_Id := N + 614; Name_Binder : constant Name_Id := N + 617;
Name_Binder_Driver : constant Name_Id := N + 615; Name_Binder_Prefix : constant Name_Id := N + 618;
Name_Binder_Prefix : constant Name_Id := N + 616; Name_Body_Suffix : constant Name_Id := N + 619;
Name_Body_Suffix : constant Name_Id := N + 617; Name_Builder : constant Name_Id := N + 620;
Name_Builder : constant Name_Id := N + 618; Name_Builder_Switches : constant Name_Id := N + 621;
Name_Builder_Switches : constant Name_Id := N + 619; Name_Compiler : constant Name_Id := N + 622;
Name_Compiler : constant Name_Id := N + 620; Name_Compiler_Kind : constant Name_Id := N + 623;
Name_Compiler_Driver : constant Name_Id := N + 621; Name_Config_Body_File_Name : constant Name_Id := N + 624;
Name_Compiler_Kind : constant Name_Id := N + 622; Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 625;
Name_Compiler_Pic_Option : constant Name_Id := N + 623; Name_Config_File_Switches : constant Name_Id := N + 626;
Name_Compute_Dependency : constant Name_Id := N + 624; Name_Config_File_Unique : constant Name_Id := N + 627;
Name_Config_Body_File_Name : constant Name_Id := N + 625; Name_Config_Spec_File_Name : constant Name_Id := N + 628;
Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 626; Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 629;
Name_Config_File_Switches : constant Name_Id := N + 627; Name_Cross_Reference : constant Name_Id := N + 630;
Name_Config_File_Unique : constant Name_Id := N + 628; Name_Default_Language : constant Name_Id := N + 631;
Name_Config_Spec_File_Name : constant Name_Id := N + 629; Name_Default_Switches : constant Name_Id := N + 632;
Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 630; Name_Dependency_Driver : constant Name_Id := N + 633;
Name_Cross_Reference : constant Name_Id := N + 631; Name_Dependency_File_Kind : constant Name_Id := N + 634;
Name_Default_Builder_Switches : constant Name_Id := N + 632; Name_Dependency_Switches : constant Name_Id := N + 635;
Name_Default_Global_Compiler_Switches : constant Name_Id := N + 633; Name_Driver : constant Name_Id := N + 636;
Name_Default_Language : constant Name_Id := N + 634; Name_Exec_Dir : constant Name_Id := N + 637;
Name_Default_Linker : constant Name_Id := N + 635; Name_Executable : constant Name_Id := N + 638;
Name_Default_Minimum_Linker_Options : constant Name_Id := N + 636; Name_Executable_Suffix : constant Name_Id := N + 639;
Name_Default_Switches : constant Name_Id := N + 637; Name_Extends : constant Name_Id := N + 640;
Name_Dependency_File_Kind : constant Name_Id := N + 638; Name_Externally_Built : constant Name_Id := N + 641;
Name_Dependency_Option : constant Name_Id := N + 639; Name_Finder : constant Name_Id := N + 642;
Name_Exec_Dir : constant Name_Id := N + 640; Name_Global_Configuration_Pragmas : constant Name_Id := N + 643;
Name_Executable : constant Name_Id := N + 641; Name_Global_Config_File : constant Name_Id := N + 644;
Name_Executable_Suffix : constant Name_Id := N + 642; Name_Gnatls : constant Name_Id := N + 645;
Name_Extends : constant Name_Id := N + 643; Name_Gnatstub : constant Name_Id := N + 646;
Name_Externally_Built : constant Name_Id := N + 644; Name_Implementation : constant Name_Id := N + 647;
Name_Finder : constant Name_Id := N + 645; Name_Implementation_Exceptions : constant Name_Id := N + 648;
Name_Global_Compiler_Switches : constant Name_Id := N + 646; Name_Implementation_Suffix : constant Name_Id := N + 649;
Name_Global_Configuration_Pragmas : constant Name_Id := N + 647; Name_Include_Option : constant Name_Id := N + 650;
Name_Global_Config_File : constant Name_Id := N + 648; Name_Include_Path : constant Name_Id := N + 651;
Name_Gnatls : constant Name_Id := N + 649; Name_Include_Path_File : constant Name_Id := N + 652;
Name_Gnatstub : constant Name_Id := N + 650; Name_Language_Kind : constant Name_Id := N + 653;
Name_Implementation : constant Name_Id := N + 651; Name_Language_Processing : constant Name_Id := N + 654;
Name_Implementation_Exceptions : constant Name_Id := N + 652; Name_Languages : constant Name_Id := N + 655;
Name_Implementation_Suffix : constant Name_Id := N + 653; Name_Library_Ali_Dir : constant Name_Id := N + 656;
Name_Include_Option : constant Name_Id := N + 654; Name_Library_Auto_Init : constant Name_Id := N + 657;
Name_Include_Path : constant Name_Id := N + 655; Name_Library_Auto_Init_Supported : constant Name_Id := N + 658;
Name_Include_Path_File : constant Name_Id := N + 656; Name_Library_Builder : constant Name_Id := N + 659;
Name_Language_Kind : constant Name_Id := N + 657; Name_Library_Dir : constant Name_Id := N + 660;
Name_Language_Processing : constant Name_Id := N + 658; Name_Library_GCC : constant Name_Id := N + 661;
Name_Languages : constant Name_Id := N + 659; Name_Library_Interface : constant Name_Id := N + 662;
Name_Library_Ali_Dir : constant Name_Id := N + 660; Name_Library_Kind : constant Name_Id := N + 663;
Name_Library_Auto_Init : constant Name_Id := N + 661; Name_Library_Name : constant Name_Id := N + 664;
Name_Library_Auto_Init_Supported : constant Name_Id := N + 662; Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 665;
Name_Library_Builder : constant Name_Id := N + 663; Name_Library_Options : constant Name_Id := N + 666;
Name_Library_Dir : constant Name_Id := N + 664; Name_Library_Partial_Linker : constant Name_Id := N + 667;
Name_Library_GCC : constant Name_Id := N + 665; Name_Library_Reference_Symbol_File : constant Name_Id := N + 668;
Name_Library_Interface : constant Name_Id := N + 666; Name_Library_Src_Dir : constant Name_Id := N + 669;
Name_Library_Kind : constant Name_Id := N + 667; Name_Library_Support : constant Name_Id := N + 670;
Name_Library_Name : constant Name_Id := N + 668; Name_Library_Symbol_File : constant Name_Id := N + 671;
Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 669; Name_Library_Symbol_Policy : constant Name_Id := N + 672;
Name_Library_Options : constant Name_Id := N + 670; Name_Library_Version : constant Name_Id := N + 673;
Name_Library_Partial_Linker : constant Name_Id := N + 671; Name_Library_Version_Switches : constant Name_Id := N + 674;
Name_Library_Reference_Symbol_File : constant Name_Id := N + 672; Name_Linker : constant Name_Id := N + 675;
Name_Library_Src_Dir : constant Name_Id := N + 673; Name_Linker_Executable_Option : constant Name_Id := N + 676;
Name_Library_Support : constant Name_Id := N + 674; Name_Linker_Lib_Dir_Option : constant Name_Id := N + 677;
Name_Library_Symbol_File : constant Name_Id := N + 675; Name_Linker_Lib_Name_Option : constant Name_Id := N + 678;
Name_Library_Symbol_Policy : constant Name_Id := N + 676; Name_Local_Config_File : constant Name_Id := N + 679;
Name_Library_Version : constant Name_Id := N + 677; Name_Local_Configuration_Pragmas : constant Name_Id := N + 680;
Name_Library_Version_Options : constant Name_Id := N + 678; Name_Locally_Removed_Files : constant Name_Id := N + 681;
Name_Linker : constant Name_Id := N + 679; Name_Mapping_File_Switches : constant Name_Id := N + 682;
Name_Linker_Executable_Option : constant Name_Id := N + 680; Name_Mapping_Spec_Suffix : constant Name_Id := N + 683;
Name_Linker_Lib_Dir_Option : constant Name_Id := N + 681; Name_Mapping_Body_Suffix : constant Name_Id := N + 684;
Name_Linker_Lib_Name_Option : constant Name_Id := N + 682; Name_Metrics : constant Name_Id := N + 685;
Name_Local_Config_File : constant Name_Id := N + 683; Name_Naming : constant Name_Id := N + 686;
Name_Local_Configuration_Pragmas : constant Name_Id := N + 684; Name_Objects_Path : constant Name_Id := N + 687;
Name_Locally_Removed_Files : constant Name_Id := N + 685; Name_Objects_Path_File : constant Name_Id := N + 688;
Name_Mapping_File_Switches : constant Name_Id := N + 686; Name_Object_Dir : constant Name_Id := N + 689;
Name_Mapping_Spec_Suffix : constant Name_Id := N + 687; Name_Pic_Option : constant Name_Id := N + 690;
Name_Mapping_Body_Suffix : constant Name_Id := N + 688; Name_Pretty_Printer : constant Name_Id := N + 691;
Name_Metrics : constant Name_Id := N + 689; Name_Prefix : constant Name_Id := N + 692;
Name_Minimum_Binder_Options : constant Name_Id := N + 690; Name_Project : constant Name_Id := N + 693;
Name_Minimum_Compiler_Options : constant Name_Id := N + 691; Name_Roots : constant Name_Id := N + 694;
Name_Minimum_Linker_Options : constant Name_Id := N + 692; Name_Required_Switches : constant Name_Id := N + 695;
Name_Naming : constant Name_Id := N + 693; Name_Run_Path_Option : constant Name_Id := N + 696;
Name_Objects_Path : constant Name_Id := N + 694; Name_Runtime_Project : constant Name_Id := N + 697;
Name_Objects_Path_File : constant Name_Id := N + 695; Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 698;
Name_Object_Dir : constant Name_Id := N + 696; Name_Shared_Library_Prefix : constant Name_Id := N + 699;
Name_Pretty_Printer : constant Name_Id := N + 697; Name_Shared_Library_Suffix : constant Name_Id := N + 700;
Name_Project : constant Name_Id := N + 698; Name_Separate_Suffix : constant Name_Id := N + 701;
Name_Roots : constant Name_Id := N + 699; Name_Source_Dirs : constant Name_Id := N + 702;
Name_Run_Path_Option : constant Name_Id := N + 700; Name_Source_Files : constant Name_Id := N + 703;
Name_Runtime_Project : constant Name_Id := N + 701; Name_Source_List_File : constant Name_Id := N + 704;
Name_Shared_Library_Minimum_Options : constant Name_Id := N + 702; Name_Spec : constant Name_Id := N + 705;
Name_Shared_Library_Prefix : constant Name_Id := N + 703; Name_Spec_Suffix : constant Name_Id := N + 706;
Name_Shared_Library_Suffix : constant Name_Id := N + 704; Name_Specification : constant Name_Id := N + 707;
Name_Separate_Suffix : constant Name_Id := N + 705; Name_Specification_Exceptions : constant Name_Id := N + 708;
Name_Source_Dirs : constant Name_Id := N + 706; Name_Specification_Suffix : constant Name_Id := N + 709;
Name_Source_Files : constant Name_Id := N + 707; Name_Stack : constant Name_Id := N + 710;
Name_Source_List_File : constant Name_Id := N + 708; Name_Switches : constant Name_Id := N + 711;
Name_Spec : constant Name_Id := N + 709; Name_Symbolic_Link_Supported : constant Name_Id := N + 712;
Name_Spec_Suffix : constant Name_Id := N + 710; Name_Toolchain_Description : constant Name_Id := N + 713;
Name_Specification : constant Name_Id := N + 711; Name_Toolchain_Version : constant Name_Id := N + 714;
Name_Specification_Exceptions : constant Name_Id := N + 712;
Name_Specification_Suffix : constant Name_Id := N + 713;
Name_Stack : constant Name_Id := N + 714;
Name_Switches : constant Name_Id := N + 715;
Name_Symbolic_Link_Supported : constant Name_Id := N + 716;
Name_Toolchain_Description : constant Name_Id := N + 717;
Name_Toolchain_Version : constant Name_Id := N + 718;
-- Other miscellaneous names used in front end -- Other miscellaneous names used in front end
Name_Unaligned_Valid : constant Name_Id := N + 719; Name_Unaligned_Valid : constant Name_Id := N + 715;
-- Ada 2005 reserved words -- Ada 2005 reserved words
First_2005_Reserved_Word : constant Name_Id := N + 720; First_2005_Reserved_Word : constant Name_Id := N + 716;
Name_Interface : constant Name_Id := N + 720; Name_Interface : constant Name_Id := N + 716;
Name_Overriding : constant Name_Id := N + 721; Name_Overriding : constant Name_Id := N + 717;
Name_Synchronized : constant Name_Id := N + 722; Name_Synchronized : constant Name_Id := N + 718;
Last_2005_Reserved_Word : constant Name_Id := N + 722; Last_2005_Reserved_Word : constant Name_Id := N + 718;
subtype Ada_2005_Reserved_Words is subtype Ada_2005_Reserved_Words is
Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word; Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
-- Mark last defined name for consistency check in Snames body -- Mark last defined name for consistency check in Snames body
Last_Predefined_Name : constant Name_Id := N + 722; Last_Predefined_Name : constant Name_Id := N + 718;
--------------------------------------- ---------------------------------------
-- Subtypes Defining Name Categories -- -- Subtypes Defining Name Categories --
...@@ -1156,6 +1151,7 @@ package Snames is ...@@ -1156,6 +1151,7 @@ package Snames is
Attribute_Digits, Attribute_Digits,
Attribute_Elaborated, Attribute_Elaborated,
Attribute_Emax, Attribute_Emax,
Attribute_Enabled,
Attribute_Enum_Rep, Attribute_Enum_Rep,
Attribute_Epsilon, Attribute_Epsilon,
Attribute_Exponent, Attribute_Exponent,
...@@ -1338,6 +1334,7 @@ package Snames is ...@@ -1338,6 +1334,7 @@ package Snames is
Pragma_Ada_2005, Pragma_Ada_2005,
Pragma_Assertion_Policy, Pragma_Assertion_Policy,
Pragma_C_Pass_By_Copy, Pragma_C_Pass_By_Copy,
Pragma_Check_Name,
Pragma_Compile_Time_Error, Pragma_Compile_Time_Error,
Pragma_Compile_Time_Warning, Pragma_Compile_Time_Warning,
Pragma_Component_Alignment, Pragma_Component_Alignment,
...@@ -1351,6 +1348,7 @@ package Snames is ...@@ -1351,6 +1348,7 @@ package Snames is
Pragma_Extensions_Allowed, Pragma_Extensions_Allowed,
Pragma_External_Name_Casing, Pragma_External_Name_Casing,
Pragma_Float_Representation, Pragma_Float_Representation,
Pragma_Implicit_Packing,
Pragma_Initialize_Scalars, Pragma_Initialize_Scalars,
Pragma_Interrupt_State, Pragma_Interrupt_State,
Pragma_License, Pragma_License,
...@@ -1547,10 +1545,6 @@ package Snames is ...@@ -1547,10 +1545,6 @@ package Snames is
-- Test to see if the name N is the name of a recognized type attribute, -- Test to see if the name N is the name of a recognized type attribute,
-- i.e. an attribute reference that returns a type -- i.e. an attribute reference that returns a type
function Is_Check_Name (N : Name_Id) return Boolean;
-- Test to see if the name N is the name of a recognized suppress check
-- as required by pragma Suppress.
function Is_Convention_Name (N : Name_Id) return Boolean; function Is_Convention_Name (N : Name_Id) return Boolean;
-- Test to see if the name N is the name of one of the recognized -- Test to see if the name N is the name of one of the recognized
-- language conventions, as required by pragma Convention, Import, -- language conventions, as required by pragma Convention, Import,
...@@ -1597,10 +1591,6 @@ package Snames is ...@@ -1597,10 +1591,6 @@ package Snames is
-- Returns the name of language convention correspoding to given -- Returns the name of language convention correspoding to given
-- convention id. -- convention id.
function Get_Check_Id (N : Name_Id) return Check_Id;
-- Returns Id of suppress check corresponding to given name. It is an error
-- to call this function with a name that is not the name of a check.
function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id; function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id;
-- Returns Id of locking policy corresponding to given name. It is an error -- Returns Id of locking policy corresponding to given name. It is an error
-- to call this function with a name that is not the name of a check. -- to call this function with a name that is not the name of a check.
...@@ -1635,7 +1625,6 @@ private ...@@ -1635,7 +1625,6 @@ private
pragma Inline (Is_Attribute_Name); pragma Inline (Is_Attribute_Name);
pragma Inline (Is_Entity_Attribute_Name); pragma Inline (Is_Entity_Attribute_Name);
pragma Inline (Is_Type_Attribute_Name); pragma Inline (Is_Type_Attribute_Name);
pragma Inline (Is_Check_Name);
pragma Inline (Is_Locking_Policy_Name); pragma Inline (Is_Locking_Policy_Name);
pragma Inline (Is_Operator_Symbol_Name); pragma Inline (Is_Operator_Symbol_Name);
pragma Inline (Is_Queuing_Policy_Name); pragma Inline (Is_Queuing_Policy_Name);
......
gcc/ada/snames.h
...@@ -72,117 +72,118 @@ extern unsigned char Get_Attribute_Id (int); ...@@ -72,117 +72,118 @@ extern unsigned char Get_Attribute_Id (int);
#define Attr_Digits 24 #define Attr_Digits 24
#define Attr_Elaborated 25 #define Attr_Elaborated 25
#define Attr_Emax 26 #define Attr_Emax 26
#define Attr_Enum_Rep 27 #define Attr_Enabled 27
#define Attr_Epsilon 28 #define Attr_Enum_Rep 28
#define Attr_Exponent 29 #define Attr_Epsilon 29
#define Attr_External_Tag 30 #define Attr_Exponent 30
#define Attr_First 31 #define Attr_External_Tag 31
#define Attr_First_Bit 32 #define Attr_First 32
#define Attr_Fixed_Value 33 #define Attr_First_Bit 33
#define Attr_Fore 34 #define Attr_Fixed_Value 34
#define Attr_Has_Access_Values 35 #define Attr_Fore 35
#define Attr_Has_Discriminants 36 #define Attr_Has_Access_Values 36
#define Attr_Identity 37 #define Attr_Has_Discriminants 37
#define Attr_Img 38 #define Attr_Identity 38
#define Attr_Integer_Value 39 #define Attr_Img 39
#define Attr_Large 40 #define Attr_Integer_Value 40
#define Attr_Last 41 #define Attr_Large 41
#define Attr_Last_Bit 42 #define Attr_Last 42
#define Attr_Leading_Part 43 #define Attr_Last_Bit 43
#define Attr_Length 44 #define Attr_Leading_Part 44
#define Attr_Machine_Emax 45 #define Attr_Length 45
#define Attr_Machine_Emin 46 #define Attr_Machine_Emax 46
#define Attr_Machine_Mantissa 47 #define Attr_Machine_Emin 47
#define Attr_Machine_Overflows 48 #define Attr_Machine_Mantissa 48
#define Attr_Machine_Radix 49 #define Attr_Machine_Overflows 49
#define Attr_Machine_Rounding 50 #define Attr_Machine_Radix 50
#define Attr_Machine_Rounds 51 #define Attr_Machine_Rounding 51
#define Attr_Machine_Size 52 #define Attr_Machine_Rounds 52
#define Attr_Mantissa 53 #define Attr_Machine_Size 53
#define Attr_Max_Size_In_Storage_Elements 54 #define Attr_Mantissa 54
#define Attr_Maximum_Alignment 55 #define Attr_Max_Size_In_Storage_Elements 55
#define Attr_Mechanism_Code 56 #define Attr_Maximum_Alignment 56
#define Attr_Mod 57 #define Attr_Mechanism_Code 57
#define Attr_Model_Emin 58 #define Attr_Mod 58
#define Attr_Model_Epsilon 59 #define Attr_Model_Emin 59
#define Attr_Model_Mantissa 60 #define Attr_Model_Epsilon 60
#define Attr_Model_Small 61 #define Attr_Model_Mantissa 61
#define Attr_Modulus 62 #define Attr_Model_Small 62
#define Attr_Null_Parameter 63 #define Attr_Modulus 63
#define Attr_Object_Size 64 #define Attr_Null_Parameter 64
#define Attr_Partition_ID 65 #define Attr_Object_Size 65
#define Attr_Passed_By_Reference 66 #define Attr_Partition_ID 66
#define Attr_Pool_Address 67 #define Attr_Passed_By_Reference 67
#define Attr_Pos 68 #define Attr_Pool_Address 68
#define Attr_Position 69 #define Attr_Pos 69
#define Attr_Priority 70 #define Attr_Position 70
#define Attr_Range 71 #define Attr_Priority 71
#define Attr_Range_Length 72 #define Attr_Range 72
#define Attr_Round 73 #define Attr_Range_Length 73
#define Attr_Safe_Emax 74 #define Attr_Round 74
#define Attr_Safe_First 75 #define Attr_Safe_Emax 75
#define Attr_Safe_Large 76 #define Attr_Safe_First 76
#define Attr_Safe_Last 77 #define Attr_Safe_Large 77
#define Attr_Safe_Small 78 #define Attr_Safe_Last 78
#define Attr_Scale 79 #define Attr_Safe_Small 79
#define Attr_Scaling 80 #define Attr_Scale 80
#define Attr_Signed_Zeros 81 #define Attr_Scaling 81
#define Attr_Size 82 #define Attr_Signed_Zeros 82
#define Attr_Small 83 #define Attr_Size 83
#define Attr_Storage_Size 84 #define Attr_Small 84
#define Attr_Storage_Unit 85 #define Attr_Storage_Size 85
#define Attr_Stream_Size 86 #define Attr_Storage_Unit 86
#define Attr_Tag 87 #define Attr_Stream_Size 87
#define Attr_Target_Name 88 #define Attr_Tag 88
#define Attr_Terminated 89 #define Attr_Target_Name 89
#define Attr_To_Address 90 #define Attr_Terminated 90
#define Attr_Type_Class 91 #define Attr_To_Address 91
#define Attr_UET_Address 92 #define Attr_Type_Class 92
#define Attr_Unbiased_Rounding 93 #define Attr_UET_Address 93
#define Attr_Unchecked_Access 94 #define Attr_Unbiased_Rounding 94
#define Attr_Unconstrained_Array 95 #define Attr_Unchecked_Access 95
#define Attr_Universal_Literal_String 96 #define Attr_Unconstrained_Array 96
#define Attr_Unrestricted_Access 97 #define Attr_Universal_Literal_String 97
#define Attr_VADS_Size 98 #define Attr_Unrestricted_Access 98
#define Attr_Val 99 #define Attr_VADS_Size 99
#define Attr_Valid 100 #define Attr_Val 100
#define Attr_Value_Size 101 #define Attr_Valid 101
#define Attr_Version 102 #define Attr_Value_Size 102
#define Attr_Wchar_T_Size 103 #define Attr_Version 103
#define Attr_Wide_Wide_Width 104 #define Attr_Wchar_T_Size 104
#define Attr_Wide_Width 105 #define Attr_Wide_Wide_Width 105
#define Attr_Width 106 #define Attr_Wide_Width 106
#define Attr_Word_Size 107 #define Attr_Width 107
#define Attr_Adjacent 108 #define Attr_Word_Size 108
#define Attr_Ceiling 109 #define Attr_Adjacent 109
#define Attr_Copy_Sign 110 #define Attr_Ceiling 110
#define Attr_Floor 111 #define Attr_Copy_Sign 111
#define Attr_Fraction 112 #define Attr_Floor 112
#define Attr_Image 113 #define Attr_Fraction 113
#define Attr_Input 114 #define Attr_Image 114
#define Attr_Machine 115 #define Attr_Input 115
#define Attr_Max 116 #define Attr_Machine 116
#define Attr_Min 117 #define Attr_Max 117
#define Attr_Model 118 #define Attr_Min 118
#define Attr_Pred 119 #define Attr_Model 119
#define Attr_Remainder 120 #define Attr_Pred 120
#define Attr_Rounding 121 #define Attr_Remainder 121
#define Attr_Succ 122 #define Attr_Rounding 122
#define Attr_Truncation 123 #define Attr_Succ 123
#define Attr_Value 124 #define Attr_Truncation 124
#define Attr_Wide_Image 125 #define Attr_Value 125
#define Attr_Wide_Wide_Image 126 #define Attr_Wide_Image 126
#define Attr_Wide_Value 127 #define Attr_Wide_Wide_Image 127
#define Attr_Wide_Wide_Value 128 #define Attr_Wide_Value 128
#define Attr_Output 129 #define Attr_Wide_Wide_Value 129
#define Attr_Read 130 #define Attr_Output 130
#define Attr_Write 131 #define Attr_Read 131
#define Attr_Elab_Body 132 #define Attr_Write 132
#define Attr_Elab_Spec 133 #define Attr_Elab_Body 133
#define Attr_Storage_Pool 134 #define Attr_Elab_Spec 134
#define Attr_Base 135 #define Attr_Storage_Pool 135
#define Attr_Class 136 #define Attr_Base 136
#define Attr_Stub_Type 137 #define Attr_Class 137
#define Attr_Stub_Type 138
/* Define the numeric values for the conventions. */ /* Define the numeric values for the conventions. */
...@@ -221,156 +222,158 @@ extern unsigned char Get_Pragma_Id (int); ...@@ -221,156 +222,158 @@ extern unsigned char Get_Pragma_Id (int);
#define Pragma_Ada_2005 3 #define Pragma_Ada_2005 3
#define Pragma_Assertion_Policy 4 #define Pragma_Assertion_Policy 4
#define Pragma_C_Pass_By_Copy 5 #define Pragma_C_Pass_By_Copy 5
#define Pragma_Compile_Time_Error 6 #define Pragma_Check_Name 6
#define Pragma_Compile_Time_Warning 7 #define Pragma_Compile_Time_Error 7
#define Pragma_Component_Alignment 8 #define Pragma_Compile_Time_Warning 8
#define Pragma_Convention_Identifier 9 #define Pragma_Component_Alignment 9
#define Pragma_Debug_Policy 10 #define Pragma_Convention_Identifier 10
#define Pragma_Detect_Blocking 11 #define Pragma_Debug_Policy 11
#define Pragma_Discard_Names 12 #define Pragma_Detect_Blocking 12
#define Pragma_Elaboration_Checks 13 #define Pragma_Discard_Names 13
#define Pragma_Eliminate 14 #define Pragma_Elaboration_Checks 14
#define Pragma_Extend_System 15 #define Pragma_Eliminate 15
#define Pragma_Extensions_Allowed 16 #define Pragma_Extend_System 16
#define Pragma_External_Name_Casing 17 #define Pragma_Extensions_Allowed 17
#define Pragma_Float_Representation 18 #define Pragma_External_Name_Casing 18
#define Pragma_Initialize_Scalars 19 #define Pragma_Float_Representation 19
#define Pragma_Interrupt_State 20 #define Pragma_Implicit_Packing 20
#define Pragma_License 21 #define Pragma_Initialize_Scalars 21
#define Pragma_Locking_Policy 22 #define Pragma_Interrupt_State 22
#define Pragma_Long_Float 23 #define Pragma_License 23
#define Pragma_No_Run_Time 24 #define Pragma_Locking_Policy 24
#define Pragma_No_Strict_Aliasing 25 #define Pragma_Long_Float 25
#define Pragma_Normalize_Scalars 26 #define Pragma_No_Run_Time 26
#define Pragma_Polling 27 #define Pragma_No_Strict_Aliasing 27
#define Pragma_Persistent_BSS 28 #define Pragma_Normalize_Scalars 28
#define Pragma_Priority_Specific_Dispatching 29 #define Pragma_Polling 29
#define Pragma_Profile 30 #define Pragma_Persistent_BSS 30
#define Pragma_Profile_Warnings 31 #define Pragma_Priority_Specific_Dispatching 31
#define Pragma_Propagate_Exceptions 32 #define Pragma_Profile 32
#define Pragma_Queuing_Policy 33 #define Pragma_Profile_Warnings 33
#define Pragma_Ravenscar 34 #define Pragma_Propagate_Exceptions 34
#define Pragma_Restricted_Run_Time 35 #define Pragma_Queuing_Policy 35
#define Pragma_Restrictions 36 #define Pragma_Ravenscar 36
#define Pragma_Restriction_Warnings 37 #define Pragma_Restricted_Run_Time 37
#define Pragma_Reviewable 38 #define Pragma_Restrictions 38
#define Pragma_Source_File_Name 39 #define Pragma_Restriction_Warnings 39
#define Pragma_Source_File_Name_Project 40 #define Pragma_Reviewable 40
#define Pragma_Style_Checks 41 #define Pragma_Source_File_Name 41
#define Pragma_Suppress 42 #define Pragma_Source_File_Name_Project 42
#define Pragma_Suppress_Exception_Locations 43 #define Pragma_Style_Checks 43
#define Pragma_Task_Dispatching_Policy 44 #define Pragma_Suppress 44
#define Pragma_Universal_Data 45 #define Pragma_Suppress_Exception_Locations 45
#define Pragma_Unsuppress 46 #define Pragma_Task_Dispatching_Policy 46
#define Pragma_Use_VADS_Size 47 #define Pragma_Universal_Data 47
#define Pragma_Validity_Checks 48 #define Pragma_Unsuppress 48
#define Pragma_Warnings 49 #define Pragma_Use_VADS_Size 49
#define Pragma_Wide_Character_Encoding 50 #define Pragma_Validity_Checks 50
#define Pragma_Abort_Defer 51 #define Pragma_Warnings 51
#define Pragma_All_Calls_Remote 52 #define Pragma_Wide_Character_Encoding 52
#define Pragma_Annotate 53 #define Pragma_Abort_Defer 53
#define Pragma_Assert 54 #define Pragma_All_Calls_Remote 54
#define Pragma_Asynchronous 55 #define Pragma_Annotate 55
#define Pragma_Atomic 56 #define Pragma_Assert 56
#define Pragma_Atomic_Components 57 #define Pragma_Asynchronous 57
#define Pragma_Attach_Handler 58 #define Pragma_Atomic 58
#define Pragma_CIL_Constructor 59 #define Pragma_Atomic_Components 59
#define Pragma_Comment 60 #define Pragma_Attach_Handler 60
#define Pragma_Common_Object 61 #define Pragma_CIL_Constructor 61
#define Pragma_Complete_Representation 62 #define Pragma_Comment 62
#define Pragma_Complex_Representation 63 #define Pragma_Common_Object 63
#define Pragma_Controlled 64 #define Pragma_Complete_Representation 64
#define Pragma_Convention 65 #define Pragma_Complex_Representation 65
#define Pragma_CPP_Class 66 #define Pragma_Controlled 66
#define Pragma_CPP_Constructor 67 #define Pragma_Convention 67
#define Pragma_CPP_Virtual 68 #define Pragma_CPP_Class 68
#define Pragma_CPP_Vtable 69 #define Pragma_CPP_Constructor 69
#define Pragma_Debug 70 #define Pragma_CPP_Virtual 70
#define Pragma_Elaborate 71 #define Pragma_CPP_Vtable 71
#define Pragma_Elaborate_All 72 #define Pragma_Debug 72
#define Pragma_Elaborate_Body 73 #define Pragma_Elaborate 73
#define Pragma_Export 74 #define Pragma_Elaborate_All 74
#define Pragma_Export_Exception 75 #define Pragma_Elaborate_Body 75
#define Pragma_Export_Function 76 #define Pragma_Export 76
#define Pragma_Export_Object 77 #define Pragma_Export_Exception 77
#define Pragma_Export_Procedure 78 #define Pragma_Export_Function 78
#define Pragma_Export_Value 79 #define Pragma_Export_Object 79
#define Pragma_Export_Valued_Procedure 80 #define Pragma_Export_Procedure 80
#define Pragma_External 81 #define Pragma_Export_Value 81
#define Pragma_Finalize_Storage_Only 82 #define Pragma_Export_Valued_Procedure 82
#define Pragma_Ident 83 #define Pragma_External 83
#define Pragma_Import 84 #define Pragma_Finalize_Storage_Only 84
#define Pragma_Import_Exception 85 #define Pragma_Ident 85
#define Pragma_Import_Function 86 #define Pragma_Import 86
#define Pragma_Import_Object 87 #define Pragma_Import_Exception 87
#define Pragma_Import_Procedure 88 #define Pragma_Import_Function 88
#define Pragma_Import_Valued_Procedure 89 #define Pragma_Import_Object 89
#define Pragma_Inline 90 #define Pragma_Import_Procedure 90
#define Pragma_Inline_Always 91 #define Pragma_Import_Valued_Procedure 91
#define Pragma_Inline_Generic 92 #define Pragma_Inline 92
#define Pragma_Inspection_Point 93 #define Pragma_Inline_Always 93
#define Pragma_Interface_Name 94 #define Pragma_Inline_Generic 94
#define Pragma_Interrupt_Handler 95 #define Pragma_Inspection_Point 95
#define Pragma_Interrupt_Priority 96 #define Pragma_Interface_Name 96
#define Pragma_Java_Constructor 97 #define Pragma_Interrupt_Handler 97
#define Pragma_Java_Interface 98 #define Pragma_Interrupt_Priority 98
#define Pragma_Keep_Names 99 #define Pragma_Java_Constructor 99
#define Pragma_Link_With 100 #define Pragma_Java_Interface 100
#define Pragma_Linker_Alias 101 #define Pragma_Keep_Names 101
#define Pragma_Linker_Constructor 102 #define Pragma_Link_With 102
#define Pragma_Linker_Destructor 103 #define Pragma_Linker_Alias 103
#define Pragma_Linker_Options 104 #define Pragma_Linker_Constructor 104
#define Pragma_Linker_Section 105 #define Pragma_Linker_Destructor 105
#define Pragma_List 106 #define Pragma_Linker_Options 106
#define Pragma_Machine_Attribute 107 #define Pragma_Linker_Section 107
#define Pragma_Main 108 #define Pragma_List 108
#define Pragma_Main_Storage 109 #define Pragma_Machine_Attribute 109
#define Pragma_Memory_Size 110 #define Pragma_Main 110
#define Pragma_No_Body 111 #define Pragma_Main_Storage 111
#define Pragma_No_Return 112 #define Pragma_Memory_Size 112
#define Pragma_Obsolescent 113 #define Pragma_No_Body 113
#define Pragma_Optimize 114 #define Pragma_No_Return 114
#define Pragma_Pack 115 #define Pragma_Obsolescent 115
#define Pragma_Page 116 #define Pragma_Optimize 116
#define Pragma_Passive 117 #define Pragma_Pack 117
#define Pragma_Preelaborable_Initialization 118 #define Pragma_Page 118
#define Pragma_Preelaborate 119 #define Pragma_Passive 119
#define Pragma_Preelaborate_05 120 #define Pragma_Preelaborable_Initialization 120
#define Pragma_Psect_Object 121 #define Pragma_Preelaborate 121
#define Pragma_Pure 122 #define Pragma_Preelaborate_05 122
#define Pragma_Pure_05 123 #define Pragma_Psect_Object 123
#define Pragma_Pure_Function 124 #define Pragma_Pure 124
#define Pragma_Remote_Call_Interface 125 #define Pragma_Pure_05 125
#define Pragma_Remote_Types 126 #define Pragma_Pure_Function 126
#define Pragma_Share_Generic 127 #define Pragma_Remote_Call_Interface 127
#define Pragma_Shared 128 #define Pragma_Remote_Types 128
#define Pragma_Shared_Passive 129 #define Pragma_Share_Generic 129
#define Pragma_Source_Reference 130 #define Pragma_Shared 130
#define Pragma_Static_Elaboration_Desired 131 #define Pragma_Shared_Passive 131
#define Pragma_Stream_Convert 132 #define Pragma_Source_Reference 132
#define Pragma_Subtitle 133 #define Pragma_Static_Elaboration_Desired 133
#define Pragma_Suppress_All 134 #define Pragma_Stream_Convert 134
#define Pragma_Suppress_Debug_Info 135 #define Pragma_Subtitle 135
#define Pragma_Suppress_Initialization 136 #define Pragma_Suppress_All 136
#define Pragma_System_Name 137 #define Pragma_Suppress_Debug_Info 137
#define Pragma_Task_Info 138 #define Pragma_Suppress_Initialization 138
#define Pragma_Task_Name 139 #define Pragma_System_Name 139
#define Pragma_Task_Storage 140 #define Pragma_Task_Info 140
#define Pragma_Time_Slice 141 #define Pragma_Task_Name 141
#define Pragma_Title 142 #define Pragma_Task_Storage 142
#define Pragma_Unchecked_Union 143 #define Pragma_Time_Slice 143
#define Pragma_Unimplemented_Unit 144 #define Pragma_Title 144
#define Pragma_Universal_Aliasing 145 #define Pragma_Unchecked_Union 145
#define Pragma_Unreferenced 146 #define Pragma_Unimplemented_Unit 146
#define Pragma_Unreferenced_Objects 147 #define Pragma_Universal_Aliasing 147
#define Pragma_Unreserve_All_Interrupts 148 #define Pragma_Unreferenced 148
#define Pragma_Volatile 149 #define Pragma_Unreferenced_Objects 149
#define Pragma_Volatile_Components 150 #define Pragma_Unreserve_All_Interrupts 150
#define Pragma_Weak_External 151 #define Pragma_Volatile 151
#define Pragma_AST_Entry 152 #define Pragma_Volatile_Components 152
#define Pragma_Interface 153 #define Pragma_Weak_External 153
#define Pragma_Priority 154 #define Pragma_AST_Entry 154
#define Pragma_Storage_Size 155 #define Pragma_Interface 155
#define Pragma_Storage_Unit 156 #define Pragma_Priority 156
#define Pragma_Storage_Size 157
#define Pragma_Storage_Unit 158
/* End of snames.h (C version of Snames package spec) */ /* End of snames.h (C version of Snames package spec) */
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