-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
Var_Kind => Undefined,
Optional_Index => False,
Attr_Kind => Unknown,
+ Read_Only => False,
Next =>
Package_Attributes.Table (To_Package.Value).First_Attribute);
Package_Attributes.Table (To_Package.Value).First_Attribute :=
Package_Attributes.Increment_Last;
Id := (Value => Package_Attributes.Last);
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 Prj.Attr.PM;
-- Data for predefined attributes and packages
- -- Names end with '#'
+ -- Names are in lower case and end with '#'
-- 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
-- 'S' for Single
-- insensitive
-- '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 '#'
Initialization_Data : constant String :=
- -- project attributes
-
- "SVobject_dir#" &
- "SVexec_dir#" &
- "LVsource_dirs#" &
- "LVsource_files#" &
- "LVlocally_removed_files#" &
- "SVsource_list_file#" &
- "SVlibrary_dir#" &
- "SVlibrary_name#" &
- "SVlibrary_kind#" &
- "SVlibrary_version#" &
- "LVlibrary_interface#" &
- "SVlibrary_auto_init#" &
- "LVlibrary_options#" &
- "SVlibrary_src_dir#" &
- "SVlibrary_ali_dir#" &
- "SVlibrary_gcc#" &
- "SVlibrary_symbol_file#" &
- "SVlibrary_symbol_policy#" &
- "SVlibrary_reference_symbol_file#" &
- "lVmain#" &
- "LVlanguages#" &
- "SVmain_language#" &
- "LVada_roots#" &
- "SVexternally_built#" &
+ -- project level attributes
+
+ -- General
+
+ "SVRname#" &
+ "lVmain#" &
+ "LVlanguages#" &
+ "SVmain_language#" &
+ "Laroots#" &
+ "SVexternally_built#" &
+
+ -- Directories
+
+ "SVobject_dir#" &
+ "SVexec_dir#" &
+ "LVsource_dirs#" &
+
+ -- Source files
+
+ "LVsource_files#" &
+ "LVlocally_removed_files#" &
+ "SVsource_list_file#" &
+
+ -- Libraries
+
+ "SVlibrary_dir#" &
+ "SVlibrary_name#" &
+ "SVlibrary_kind#" &
+ "SVlibrary_version#" &
+ "LVlibrary_interface#" &
+ "SVlibrary_auto_init#" &
+ "LVlibrary_options#" &
+ "SVlibrary_src_dir#" &
+ "SVlibrary_ali_dir#" &
+ "SVlibrary_gcc#" &
+ "SVlibrary_symbol_file#" &
+ "SVlibrary_symbol_policy#" &
+ "SVlibrary_reference_symbol_file#" &
+
+ -- Configuration - General
+
+ "SVdefault_language#" &
+ "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
- "Pnaming#" &
- "Saspecification_suffix#" &
- "Saspec_suffix#" &
- "Saimplementation_suffix#" &
- "Sabody_suffix#" &
- "SVseparate_suffix#" &
- "SVcasing#" &
- "SVdot_replacement#" &
- "sAspecification#" &
- "sAspec#" &
- "sAimplementation#" &
- "sAbody#" &
- "Laspecification_exceptions#" &
- "Laimplementation_exceptions#" &
+ "Pnaming#" &
+ "Saspecification_suffix#" &
+ "Saspec_suffix#" &
+ "Saimplementation_suffix#" &
+ "Sabody_suffix#" &
+ "SVseparate_suffix#" &
+ "SVcasing#" &
+ "SVdot_replacement#" &
+ "sAspecification#" &
+ "sAspec#" &
+ "sAimplementation#" &
+ "sAbody#" &
+ "Laspecification_exceptions#" &
+ "Laimplementation_exceptions#" &
-- package Compiler
- "Pcompiler#" &
- "Ladefault_switches#" &
- "Lcswitches#" &
- "SVlocal_configuration_pragmas#" &
+ "Pcompiler#" &
+ "Ladefault_switches#" &
+ "Lcswitches#" &
+ "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
- "Pbuilder#" &
- "Ladefault_switches#" &
- "Lcswitches#" &
- "Scexecutable#" &
- "SVexecutable_suffix#" &
- "SVglobal_configuration_pragmas#" &
+ "Pbuilder#" &
+ "Ladefault_switches#" &
+ "Lcswitches#" &
+ "Scexecutable#" &
+ "SVexecutable_suffix#" &
+ "SVglobal_configuration_pragmas#" &
+ "Saglobal_config_file#" &
-- package gnatls
- "Pgnatls#" &
- "LVswitches#" &
+ "Pgnatls#" &
+ "LVswitches#" &
-- package Binder
- "Pbinder#" &
- "Ladefault_switches#" &
- "Lcswitches#" &
+ "Pbinder#" &
+ "Ladefault_switches#" &
+ "Lcswitches#" &
+
+ -- Configuration - Binding
+
+ "Sadriver#" &
+ "Saprefix#" &
+ "Saobjects_path#" &
+ "Saobjects_path_file#" &
-- package Linker
- "Plinker#" &
- "Ladefault_switches#" &
- "Lcswitches#" &
- "LVlinker_options#" &
+ "Plinker#" &
+ "LVrequired_switches#" &
+ "Ladefault_switches#" &
+ "Lcswitches#" &
+ "LVlinker_options#" &
+
+ -- Configuration - Linking
+
+ "SVdriver#" &
+ "LVexecutable_switch#" &
+ "SVlib_dir_switch#" &
+ "SVlib_name_switch#" &
-- package Cross_Reference
- "Pcross_reference#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pcross_reference#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Finder
- "Pfinder#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pfinder#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Pretty_Printer
- "Ppretty_printer#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Ppretty_printer#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package gnatstub
- "Pgnatstub#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pgnatstub#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Check
- "Pcheck#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pcheck#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Eliminate
- "Peliminate#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Peliminate#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Metrics
- "Pmetrics#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pmetrics#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Ide
- "Pide#" &
- "Ladefault_switches#" &
- "SVremote_host#" &
- "SVprogram_host#" &
- "SVcommunication_protocol#" &
- "Sacompiler_command#" &
- "SVdebugger_command#" &
- "SVgnatlist#" &
- "SVvcs_kind#" &
- "SVvcs_file_check#" &
- "SVvcs_log_check#" &
+ "Pide#" &
+ "Ladefault_switches#" &
+ "SVremote_host#" &
+ "SVprogram_host#" &
+ "SVcommunication_protocol#" &
+ "Sacompiler_command#" &
+ "SVdebugger_command#" &
+ "SVgnatlist#" &
+ "SVvcs_kind#" &
+ "SVvcs_file_check#" &
+ "SVvcs_log_check#" &
-- package Stack
- "Pstack#" &
- "LVswitches#" &
-
- -- package Language_Processing
+ "Pstack#" &
+ "LVswitches#" &
- "Planguage_processing#" &
- "Lacompiler_driver#" &
- "Sacompiler_kind#" &
- "Ladependency_option#" &
- "Lacompute_dependency#" &
- "Lainclude_option#" &
- "Sabinder_driver#" &
- "SVdefault_linker#" &
-
- "#";
+ "#";
Initialized : Boolean := False;
-- A flag to avoid multiple initialization
Is_An_Attribute : Boolean := False;
Var_Kind : Variable_Kind := Undefined;
Optional_Index : Boolean := False;
- Attr_Kind : Attribute_Kind := Single;
+ Attr_Kind : Attribute_Kind := Single;
Package_Name : Name_Id := No_Name;
Attribute_Name : Name_Id := No_Name;
First_Attribute : Attr_Node_Id := Attr.First_Attribute;
+ Read_Only : Boolean;
function Attribute_Location return String;
-- Returns a string depending if we are in the project level attributes
Package_Attributes.Increment_Last;
Current_Package := Package_Attributes.Last;
Package_Attributes.Table (Current_Package) :=
- (Name => Package_Name,
- Known => True,
- First_Attribute => Empty_Attr);
+ (Name => Package_Name,
+ Known => True,
+ First_Attribute => Empty_Attr);
Start := Finish + 1;
when 'S' =>
end case;
Start := Start + 1;
+
+ if Initialization_Data (Start) = 'R' then
+ Read_Only := True;
+ Start := Start + 1;
+
+ else
+ Read_Only := False;
+ end if;
+
Finish := Start;
while Initialization_Data (Finish) /= '#' loop
Var_Kind => Var_Kind,
Optional_Index => Optional_Index,
Attr_Kind => Attr_Kind,
+ Read_Only => Read_Only,
Next => Empty_Attr);
Start := Finish + 1;
end if;
Initialized := True;
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 --
----------------
Var_Kind => Var_Kind,
Optional_Index => Opt_Index,
Attr_Kind => Real_Attr_Kind,
+ Read_Only => False,
Next => First_Attr);
Package_Attributes.Table (In_Package.Value).First_Attribute :=
Attrs.Last;
Package_Attributes.Increment_Last;
Id := (Value => 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;
procedure Register_New_Package
Var_Kind => Attributes (Index).Var_Kind,
Optional_Index => Attributes (Index).Opt_Index,
Attr_Kind => Attr_Kind,
+ Read_Only => False,
Next => First_Attr);
First_Attr := Attrs.Last;
end loop;
Package_Attributes.Increment_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;
---------------------------
-- Returns True if Attribute is a known attribute and may have an
-- optional index. Returns False otherwise.
+ function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean;
+
function Next_Attribute
(After : Attribute_Node_Id) return Attribute_Node_Id;
-- Returns the attribute that follow After in the list of project level
Var_Kind : Variable_Kind;
Optional_Index : Boolean;
Attr_Kind : Attribute_Kind;
+ Read_Only : Boolean;
Next : Attr_Node_Id;
end record;
-- Data for an attribute
package Attrs is
- new Table.Table
- (Table_Component_Type => Attribute_Record,
- Table_Index_Type => Attr_Node_Id,
- Table_Low_Bound => First_Attribute,
- Table_Initial => Attributes_Initial,
- Table_Increment => Attributes_Increment,
- Table_Name => "Prj.Attr.Attrs");
+ new Table.Table (Table_Component_Type => Attribute_Record,
+ Table_Index_Type => Attr_Node_Id,
+ Table_Low_Bound => First_Attribute,
+ Table_Initial => Attributes_Initial,
+ Table_Increment => Attributes_Increment,
+ Table_Name => "Prj.Attr.Attrs");
-- The table of the attributes
--------------
--------------
type Package_Record is record
- Name : Name_Id;
- Known : Boolean := True;
- First_Attribute : Attr_Node_Id;
+ Name : Name_Id;
+ Known : Boolean := True;
+ First_Attribute : Attr_Node_Id;
end record;
-- Data for a package
package Package_Attributes is
- new Table.Table
- (Table_Component_Type => Package_Record,
- Table_Index_Type => Pkg_Node_Id,
- Table_Low_Bound => First_Package,
- Table_Initial => Packages_Initial,
- Table_Increment => Packages_Increment,
- Table_Name => "Prj.Attr.Packages");
+ new Table.Table (Table_Component_Type => Package_Record,
+ Table_Index_Type => Pkg_Node_Id,
+ Table_Low_Bound => First_Package,
+ Table_Initial => Packages_Initial,
+ Table_Increment => Packages_Increment,
+ Table_Name => "Prj.Attr.Packages");
-- The table of the packages
end Prj.Attr;
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
------------------------------------------------------------------------------
--- The following package declares data types for GNAT project.
--- These data types are used in the bodies of the Prj hierarchy.
-
--- Above comment seems *far* too general ???
+-- The following package declares a Fail procedure that is used in the
+-- Project Manager.
with Osint;
-- --
------------------------------------------------------------------------------
-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 Prj.Attr; use Prj.Attr;
+with Prj.Attr.PM; use Prj.Attr.PM;
with Prj.Err; use Prj.Err;
with Prj.Strt; use Prj.Strt;
with Prj.Tree; use Prj.Tree;
with Snames;
-with Prj.Attr; use Prj.Attr;
-with Prj.Attr.PM; use Prj.Attr.PM;
with Uintp; use Uintp;
package body Prj.Dect is
-- 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 ..
Optional_Index_Case_Insensitive_Associative_Array
- then
- Set_Case_Insensitive (Attribute, In_Tree, To => True);
+ then
+ Set_Case_Insensitive (Attribute, In_Tree, To => True);
+ end if;
end if;
Scan (In_Tree); -- past the attribute name
Expect (Tok_String_Literal, "literal string");
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
if Token = Tok_At then
end if;
if Token = Tok_Renames then
+ if In_Configuration then
+ Error_Msg
+ ("no package renames in configuration projects", Token_Ptr);
+ end if;
-- Scan past "renames"
and then Token_Name /= Name_Of (Package_Declaration, In_Tree)
then
Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree);
- Error_Msg ("expected %", Token_Ptr);
+ Error_Msg ("expected %%", Token_Ptr);
end if;
if Token /= Tok_Semicolon then
Current_Package : Project_Node_Id)
is
Expression_Location : Source_Ptr;
- String_Type_Name : Name_Id := No_Name;
- Project_String_Type_Name : Name_Id := No_Name;
- Type_Location : Source_Ptr := No_Location;
- Project_Location : Source_Ptr := No_Location;
- Expression : Project_Node_Id := Empty_Node;
+ String_Type_Name : Name_Id := No_Name;
+ Project_String_Type_Name : Name_Id := No_Name;
+ Type_Location : Source_Ptr := No_Location;
+ Project_Location : Source_Ptr := No_Location;
+ Expression : Project_Node_Id := Empty_Node;
Variable_Name : constant Name_Id := Token_Name;
- OK : Boolean := True;
+ OK : Boolean := True;
begin
Variable :=
package body Prj.Env is
Current_Source_Path_File : Path_Name_Type := No_Path;
- -- Current value of project source path file env var. Used to avoid setting
- -- the env var to the same value.
+ -- Current value of project source path file env var.
+ -- Used to avoid setting the env var to the same value.
Current_Object_Path_File : Path_Name_Type := No_Path;
- -- Current value of project object path file env var. Used to avoid setting
- -- the env var to the same value.
+ -- Current value of project object path file env var.
+ -- Used to avoid setting the env var to the same value.
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;
-- Index of the last valid character in Ada_Path_Buffer
-----------------------
function Body_Path_Name_Of
- (Unit : Unit_Id;
+ (Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the body of a unit.
-- Compute it first, if necessary.
function Spec_Path_Name_Of
- (Unit : Unit_Id;
+ (Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the spec of a unit.
-- Compute it first, if necessary.
procedure Add_To_Path (Dir : String);
-- 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
- -- Path_Separator character to Path.
+ -- Increment Ada_Path_Length.
+ -- If Ada_Path_Length /= 0, prepend a Path_Separator character to
+ -- Path.
procedure Add_To_Source_Path
(Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref);
- -- Add to Ada_Path_B all the source directories in string list Source_Dirs,
- -- if any. Increment Ada_Path_Length.
+ -- Add to Ada_Path_B all the source directories in string list
+ -- Source_Dirs, if any. Increment Ada_Path_Length.
procedure Add_To_Object_Path
(Object_Dir : Path_Name_Type;
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean;
-- 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);
-- Call Setenv, after calling To_Host_File_Spec
------------------------
procedure Add_To_Object_Path
- (Object_Dir : Path_Name_Type;
- In_Tree : Project_Tree_Ref)
+ (Object_Dir : Path_Name_Type; In_Tree : Project_Tree_Ref)
is
begin
-- Check if the directory is already in the table
-- If it is already, no need to add it
if In_Tree.Private_Part.Source_Paths.Table (Index) =
- File_Name_Type (Source_Dir.Value)
+ Source_Dir.Value
then
Add_It := False;
exit;
(In_Tree.Private_Part.Source_Paths);
In_Tree.Private_Part.Source_Paths.Table
(Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) :=
- File_Name_Type (Source_Dir.Value);
+ Source_Dir.Value;
end if;
-- Next source directory
-----------------------
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
Data : Unit_Data := In_Tree.Units.Table (Unit);
-- If we don't know the path name of the body of this unit,
-- 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
Current_Source : String_List_Id :=
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;
begin
-- By default, put the file name
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
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is
Dir_Name : constant String := Get_Name_String (Dir);
Direct : Dir_Type;
- Name : String (1 .. 1_000); -- what is this magic constant 1000 ???
+ Name : String (1 .. 1_000);
Last : Natural;
Result : Boolean := False;
File_Name : Path_Name_Type := No_Path;
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;
(File, "pragma Source_File_Name_Project");
Put_Line
(File, " (Spec_File_Name => ""*" &
- Namet.Get_Name_String (Data.Naming.Ada_Spec_Suffix) &
+ Spec_Suffix_Of (In_Tree, "ada", Data.Naming) &
""",");
Put_Line
(File, " Casing => " &
(File, "pragma Source_File_Name_Project");
Put_Line
(File, " (Body_File_Name => ""*" &
- Namet.Get_Name_String (Data.Naming.Ada_Body_Suffix) &
+ Body_Suffix_Of (In_Tree, "ada", Data.Naming) &
""",");
Put_Line
(File, " Casing => " &
-- and maybe separate
- if
- Data.Naming.Ada_Body_Suffix /= Data.Naming.Separate_Suffix
+ if Body_Suffix_Of (In_Tree, "ada", Data.Naming) /=
+ Get_Name_String (Data.Naming.Separate_Suffix)
then
Put_Line
(File, "pragma Source_File_Name_Project");
if File = Invalid_FD then
Prj.Com.Fail
("unable to create temporary configuration pragmas file");
- elsif Opt.Verbose_Mode then
- Write_Str ("Creating temp file """);
- Write_Str (Get_Name_String (File_Name));
- Write_Line ("""");
+
+ else
+ Record_Temp_File (File_Name);
+
+ if Opt.Verbose_Mode then
+ Write_Str ("Creating temp file """);
+ Write_Str (Get_Name_String (File_Name));
+ Write_Line ("""");
+ end if;
end if;
end if;
end Check_Temp_File;
if File = Invalid_FD then
Prj.Com.Fail ("unable to create temporary mapping file");
- elsif Opt.Verbose_Mode then
- Write_Str ("Creating temp mapping file """);
- Write_Str (Get_Name_String (Name));
- Write_Line ("""");
+ 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;
if Fill_Mapping_File then
end if;
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 --
--------------------------
Tempdir.Create_Temp_File (Path_FD, Path_Name);
if Path_Name /= No_Path then
+ Record_Temp_File (Path_Name);
- -- Record the name, so that the temp path file will be deleted
- -- at the end of the program.
+ -- Record the name, so that the temp path file will be deleted at the
+ -- end of the program.
Path_File_Table.Increment_Last (In_Tree.Private_Part.Path_Files);
In_Tree.Private_Part.Path_Files.Table
Original_Name : String := Name;
Extended_Spec_Name : String :=
- Name & Namet.Get_Name_String
- (Data.Naming.Ada_Spec_Suffix);
+ Name &
+ Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String :=
- Name & Namet.Get_Name_String
- (Data.Naming.Ada_Body_Suffix);
+ Name &
+ Body_Suffix_Of (In_Tree, "ada", Data.Naming);
Unit : Unit_Data;
- The_Original_Name : File_Name_Type;
- The_Spec_Name : File_Name_Type;
- The_Body_Name : File_Name_Type;
+ The_Original_Name : Name_Id;
+ The_Spec_Name : Name_Id;
+ The_Body_Name : Name_Id;
begin
Canonical_Case_File_Name (Original_Name);
Write_Eol;
end if;
- -- For extending project, search in the extended project
- -- if the source is not found. For non extending projects,
- -- this loop will be run only once.
+ -- For extending project, search in the extended project if the source
+ -- is not found. For non extending projects, this loop will be run only
+ -- once.
loop
-- Loop through units
-- If it has the name of the original name, return the
-- original name.
- if Name_Id (Unit.Name) = Name_Id (The_Original_Name)
- -- Type confusion in above comparison ???
- or else Current_Name = The_Original_Name
+ if Unit.Name = The_Original_Name
+ or else
+ Current_Name = File_Name_Type (The_Original_Name)
then
if Current_Verbosity = High then
Write_Line (" OK");
-- If it has the name of 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
Write_Line (" OK");
end if;
-- If name same as original name, return original name
- if Name_Id (Unit.Name) = Name_Id (The_Original_Name)
- -- Type confusion in the above comparison ???
- or else Current_Name = The_Original_Name
+ if Unit.Name = The_Original_Name
+ or else
+ Current_Name = File_Name_Type (The_Original_Name)
then
if Current_Verbosity = High then
Write_Line (" OK");
-- If it has the same name as 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
Write_Line (" OK");
end if;
Seen : Project_List := Empty_Project_List;
procedure Add (Project : Project_Id);
- -- Process a project. Remember the processes visited to avoid
- -- processing a project twice. Recursively process an eventual
- -- extended project, and all imported projects.
+ -- Process a project. Remember the processes visited to avoid processing
+ -- a project twice. Recursively process an eventual extended project,
+ -- and all imported projects.
---------
-- Add --
-- for sure we never visited this project.
if Seen = Empty_Project_List then
- Project_List_Table.Increment_Last
- (In_Tree.Project_Lists);
- Seen :=
- Project_List_Table.Last (In_Tree.Project_Lists);
+ Project_List_Table.Increment_Last (In_Tree.Project_Lists);
+ Seen := Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List);
-- This project has never been visited, add it
-- 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 :=
Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table
end;
end if;
- -- If there is an object directory, call Action
- -- with its name
+ -- If there is an object directory, call Action with its name
if Data.Object_Directory /= No_Path then
Get_Name_String (Data.Display_Object_Dir);
-- Start of processing for For_All_Object_Dirs
begin
- -- Visit this project, and its imported projects,
- -- recursively
+ -- Visit this project, and its imported projects, recursively
Add (Project);
end For_All_Object_Dirs;
Seen : Project_List := Empty_Project_List;
procedure Add (Project : Project_Id);
- -- Process a project. Remember the processes visited to avoid
- -- processing a project twice. Recursively process an eventual
- -- extended project, and all imported projects.
+ -- Process a project. Remember the processes visited to avoid processing
+ -- a project twice. Recursively process an eventual extended project,
+ -- and all imported projects.
---------
-- Add --
---------
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;
begin
- -- If the list of visited project is empty, then
- -- for sure we never visited this project.
+ -- If the list of visited project is empty, then for sure we never
+ -- visited this project.
if Seen = Empty_Project_List then
- Project_List_Table.Increment_Last (In_Tree.Project_Lists);
- Seen := Project_List_Table.Last (In_Tree.Project_Lists);
+ Project_List_Table.Increment_Last
+ (In_Tree.Project_Lists);
+ Seen := Project_List_Table.Last
+ (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List);
exit when
In_Tree.Project_Lists.Table (Current).Next =
Empty_Project_List;
-
- Current := In_Tree.Project_Lists.Table (Current).Next;
+ Current :=
+ In_Tree.Project_Lists.Table (Current).Next;
end loop;
- -- This project has never been visited, add it
- -- to the list.
+ -- This project has never been visited, add it 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 :=
Project_List_Table.Last (In_Tree.Project_Lists);
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);
end;
end if;
-- If there are Ada sources, call action with the name of every
-- 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
- The_String := In_Tree.String_Elements.Table (Current);
+ The_String :=
+ In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value));
Current := The_String.Next;
end loop;
(Source_File_Name : String;
In_Tree : Project_Tree_Ref;
Project : out Project_Id;
- Path : out File_Name_Type)
+ Path : out Path_Name_Type)
is
begin
-- Body below could use some comments ???
and then
Namet.Get_Name_String
(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
Namet.Get_Name_String
- (Unit.File_Names (Specification).Path) =
+ (Unit.File_Names (Specification).Path) =
Original_Name)
then
Project := Ultimate_Extension_Of
and then
Namet.Get_Name_String
(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
(Unit.File_Names (Body_Part).Path) =
Original_Name)
end;
Project := No_Project;
- Path := No_File;
+ Path := No_Path;
if Current_Verbosity > Default then
Write_Str ("Cannot be found.");
Original_Name : String := Name;
Extended_Spec_Name : String :=
- Name & Namet.Get_Name_String
- (Data.Naming.Ada_Spec_Suffix);
+ Name &
+ Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String :=
- Name & Namet.Get_Name_String
- (Data.Naming.Ada_Body_Suffix);
+ Name &
+ Body_Suffix_Of (In_Tree, "ada", Data.Naming);
- First : Unit_Id;
- Current : Unit_Id;
+ First : Unit_Index := Unit_Table.First;
+ Current : Unit_Index;
Unit : Unit_Data;
begin
Write_Eol;
end if;
- First := Unit_Table.First;
while First <= Unit_Table.Last (In_Tree.Units)
and then In_Tree.Units.Table
(First).File_Names (Body_Part).Project /= Project
Original_Name : String := Name;
Data : constant Project_Data :=
- In_Tree.Projects.Table (Main_Project);
+ In_Tree.Projects.Table (Main_Project);
Extended_Spec_Name : String :=
- Name & Namet.Get_Name_String
- (Data.Naming.Ada_Spec_Suffix);
+ Name &
+ Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String :=
- Name & Namet.Get_Name_String
- (Data.Naming.Ada_Body_Suffix);
+ Name &
+ Body_Suffix_Of (In_Tree, "ada", Data.Naming);
Unit : Unit_Data;
The_Spec_Name : File_Name_Type;
The_Body_Name : File_Name_Type;
- -- Confusion here between unit names/file names, See ??? comments below
-
begin
Canonical_Case_File_Name (Original_Name);
Name_Len := Original_Name'Length;
-- If it has the name of the original name or the body name,
-- 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_Body_Name
then
-- If name same as the original name, or the spec name, 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_Spec_Name
then
begin
if Process_Source_Dirs then
- -- Add to path all source directories of this project
- -- if there are Ada sources.
+ -- Add to path all source directories of this project if
+ -- there are Ada sources.
- if In_Tree.Projects.Table
- (Project).Ada_Sources_Present
+ if In_Tree.Projects.Table (Project).Ada_Sources /=
+ Nil_String
then
Add_To_Source_Path (Data.Source_Dirs, In_Tree);
end if;
if Process_Object_Dirs then
-- Add to path the object directory of this project
- -- except if we don't include library project and
- -- this is a library project.
+ -- except if we don't include library project and this
+ -- is a library project.
if (Data.Library and then Including_Libraries)
or else
and then
(not Including_Libraries or else not Data.Library))
then
- -- For a library project, add library ALI directory if
- -- there is no object directory or if the library ALI
- -- directory contains ALI files, otherwise add the
- -- object directory.
+ -- For a library project, add the library ALI
+ -- directory if there is no object directory or
+ -- if the library ALI directory contains ALI files;
+ -- otherwise add the object directory.
if Data.Library then
if Data.Object_Directory = No_Path
end if;
-- For a non-library project, add the object
- -- directory, if it is not a virtual project, and
- -- if there are Ada sources or if the project is an
+ -- directory, if it is not a virtual project, and if
+ -- there are Ada sources or if the project is an
-- extending project. if There Are No Ada sources,
- -- adding the object directory could disrupt
- -- the order of the object dirs in the path.
+ -- adding the object directory could disrupt the order
+ -- of the object dirs in the path.
elsif not Data.Virtual
- and then (In_Tree.Projects.Table
- (Project).Ada_Sources_Present
- or else
- (Data.Extends /= No_Project
- and then
- Data.Object_Directory /= No_Path))
+ and then There_Are_Ada_Sources (In_Tree, Project)
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;
-----------------------
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
Data : Unit_Data := In_Tree.Units.Table (Unit);
begin
- if Data.File_Names (Specification).Path = No_File then
+ if Data.File_Names (Specification).Path = No_Path then
declare
Current_Source : String_List_Id :=
In_Tree.Projects.Table
- (Data.File_Names (Specification).Project).Sources;
+ (Data.File_Names (Specification).Project).Ada_Sources;
Path : GNAT.OS_Lib.String_Access;
begin
Data.File_Names (Specification).Path :=
- Data.File_Names (Specification).Name;
+ Path_Name_Type (Data.File_Names (Specification).Name);
while Current_Source /= Nil_String loop
Path := Locate_Regular_File
-- 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.
+ 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;
-- When creating a mapping file, create an empty map. This case occurs
-- when run time source files are found in the project files.
-- a temporary file that contains all configuration pragmas, and specify
-- 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
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_Access;
(Source_File_Name : String;
In_Tree : Project_Tree_Ref;
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
generic
with Output; use Output;
with Osint; use Osint;
with Sdefault;
+with Table;
with GNAT.HTable;
package body Prj.Ext is
- Gpr_Project_Path : constant String := "GPR_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
-- ADA_PROJECT_PATH.
-- first for external reference in this table, before checking the
-- environment. Htable is emptied (reset) by procedure Reset.
+ ---------
package Search_Directories is new Table.Table
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Name => "Prj.Ext.Search_Directories");
-- The table for the directories specified with -aP switches
- ---------
-- Add --
---------
Htable.Set (The_Key, The_Value);
end Add;
+ -----------
----------------------------------
-- Add_Search_Project_Directory --
----------------------------------
Search_Directories.Append (Name_Find);
end Add_Search_Project_Directory;
- -----------
-- Check --
-----------
Last : Positive;
New_Len : Positive;
New_Last : Positive;
- Prj_Path : String_Access := null;
+ Prj_Path : String_Access := Gpr_Prj_Path;
begin
- 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;
+ if Get_Mode = Ada_Only then
+ if Gpr_Prj_Path.all /= "" then
- -- Warn if both environment variables are defined
+ -- Warn if both environment variables are defined
- if Ada_Prj_Path.all /= "" then
- Write_Line ("Warning: ADA_PROJECT_PATH is not taken into account");
- Write_Line (" when GPR_PROJECT_PATH is defined");
- end if;
+ if Ada_Prj_Path.all /= "" then
+ Write_Line
+ ("Warning: ADA_PROJECT_PATH is not taken into account");
+ Write_Line (" when GPR_PROJECT_PATH is defined");
+ end if;
- elsif Ada_Prj_Path.all /= "" then
- if Hostparm.OpenVMS then
- Prj_Path := To_Canonical_Path_Spec ("ADA_PROJECT_PATH:");
else
- Prj_Path := To_Canonical_Path_Spec (Ada_Prj_Path.all);
+ Prj_Path := Ada_Prj_Path;
end if;
end if;
(Get_Name_String (Search_Directories.Table (J)));
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_Buffer (Name_Len) := Path_Separator;
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
or else not Is_Absolute_Path (Name_Buffer (First .. Last))
then
Prefix := new String'(Executable_Prefix_Path);
if Prefix.all /= "" then
- Current_Project_Path :=
- new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
- Prefix.all & Directory_Separator & "gnat");
+ if Get_Mode = Ada_Only then
+ Current_Project_Path :=
+ new String'(Name_Buffer (1 .. Name_Len) &
+ Path_Separator &
+ 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;
else
".." & Directory_Separator & "gnat");
end if;
end;
- else
+ end if;
+
+ if Current_Project_Path = null then
Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len));
end if;
end Initialize_Project_Path;
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);
-- Add a directory to the project path. Directories added with this
-- procedure are added in order after the current directory and before
-- --
------------------------------------------------------------------------------
+with GNAT.Case_Util; use GNAT.Case_Util;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.HTable;
+
with Err_Vars; use Err_Vars;
with Fmap; use Fmap;
with Hostparm;
-with MLib.Tgt; use MLib.Tgt;
+with MLib.Tgt;
with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
-with GNAT.Case_Util; use GNAT.Case_Util;
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with GNAT.HTable;
-
package body Prj.Nmsc is
+ No_Continuation_String : aliased String := "";
+ Continuation_String : aliased String := "\";
+ -- Used in Check_Library for continuation error messages at the same
+ -- location.
+
Error_Report : Put_Line_Access := null;
-- Set to point to error reporting procedure
type Name_Location is record
Name : File_Name_Type;
Location : Source_Ptr;
+ Source : Source_Id := No_Source;
+ Except : Boolean := False;
Found : Boolean := False;
end record;
-- Information about file names found in string list attribute
No_Name_Location : constant Name_Location :=
(Name => No_File,
Location => No_Location,
+ Source => No_Source,
+ Except => False,
Found => False);
package Source_Names is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
- Key => File_Name_Type,
+ Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Hash table to store recursive source directories, to avoid looking
-- A table to check if a unit with an exceptional name will hide
-- a source with a file name following the naming convention.
+ procedure Add_Source
+ (Id : Source_Id;
+ Data : in out Project_Data;
+ In_Tree : Project_Tree_Ref);
+ -- Add a new source to the different lists: list of all sources in the
+ -- project tree, list of source of a project and list of sources of a
+ -- language.
+
function ALI_File_Name (Source : String) return String;
-- Return the ALI file name corresponding to a source
procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
- -- Check that Name is a valid Ada unit name. If not, an error message is
- -- output, and Unit is set to No_Name, otherwise Unit is set to the
- -- unit name referenced by Name.
+ -- Check that a name is a valid Ada unit name
- procedure Check_Naming_Scheme
+ procedure Check_Naming_Schemes
(Data : in out Project_Data;
Project : Project_Id;
In_Tree : Project_Tree_Ref);
Naming : Naming_Data);
-- Check that the package Naming is correct
+ procedure Check_Configuration
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data);
+ -- Check the configuration attributes for the project
+
procedure Check_For_Source
(File_Name : File_Name_Type;
- Path_Name : File_Name_Type;
+ Path_Name : Path_Name_Type;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
-- In_Tree and modify its data Data if it has the value "true".
procedure Check_Library_Attributes
- (Project : Project_Id;
+ (Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data);
+ Data : in out Project_Data);
-- Check the library attributes of project Project in project tree In_Tree
-- and modify its data Data accordingly.
-- modify its data Data accordingly.
procedure Check_Programming_Languages
- (In_Tree : Project_Tree_Ref; Data : in out Project_Data);
+ (In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ Data : in out Project_Data);
-- Check attribute Languages for the project with data Data in project
-- tree In_Tree and set the components of Data for all the programming
-- languages indicated in attribute Languages, if any.
-- Return the index of the last significant character in Dir. This is used
-- to avoid duplicates '/' at the end of directory names
- function Body_Suffix_Of
- (Language : Language_Index;
- In_Project : Project_Data;
- In_Tree : Project_Tree_Ref)
- return String;
- -- Returns the suffix of sources of language Language in project In_Project
- -- in project tree In_Tree.
-
procedure Error_Msg
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
-- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
-- Error_Report.
+ procedure Find_Ada_Sources
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Follow_Links : Boolean := False);
+ -- Find all the Ada sources in all of the source directories of a project
+
procedure Find_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
-- Source_Names.
procedure Get_Unit
- (Canonical_File_Name : File_Name_Type;
+ (In_Tree : Project_Tree_Ref;
+ Canonical_File_Name : File_Name_Type;
Naming : Naming_Data;
Exception_Id : out Ada_Naming_Exception_Id;
Unit_Name : out Name_Id;
function Path_Name_Of
(File_Name : File_Name_Type;
Directory : Path_Name_Type) return String;
- -- Returns the path name of a (non project) file. Returns an empty string
- -- if file cannot be found.
+ -- Returns the path name of a (non project) file.
+ -- Returns an empty string if file cannot be found.
procedure Prepare_Ada_Naming_Exceptions
(List : Array_Element_Id;
procedure Record_Ada_Source
(File_Name : File_Name_Type;
- Path_Name : File_Name_Type;
+ Path_Name : Path_Name_Type;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
-- When Naming_Exceptions is True, mark the found sources as such, to
-- later remove those that are not named in a list of sources.
- procedure Report_No_Ada_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Location : Source_Ptr);
+ procedure Remove_Source
+ (Id : Source_Id;
+ Replaced_By : Source_Id;
+ Project : Project_Id;
+ Data : in out Project_Data;
+ In_Tree : Project_Tree_Ref);
+
+ procedure Report_No_Sources
+ (Project : Project_Id;
+ Lang_Name : String;
+ In_Tree : Project_Tree_Ref;
+ Location : Source_Ptr);
-- Report an error or a warning depending on the value of When_No_Sources
+ -- when there are no sources for language Lang_Name.
procedure Show_Source_Dirs
- (Project : Project_Id; In_Tree : Project_Tree_Ref);
+ (Data : Project_Data; In_Tree : Project_Tree_Ref);
-- List all the source directories of a project
function Suffix_For
-- Check that individual naming conventions apply to immediate
-- sources of the project; if not, issue a warning.
+ ----------------
+ -- Add_Source --
+ ----------------
+
+ procedure Add_Source
+ (Id : Source_Id;
+ Data : in out Project_Data;
+ In_Tree : Project_Tree_Ref)
+ is
+ Language : constant Language_Index :=
+ In_Tree.Sources.Table (Id).Language;
+
+ Source : Source_Id;
+
+ begin
+ -- Add the source to the global list
+
+ In_Tree.Sources.Table (Id).Next_In_Sources := In_Tree.First_Source;
+ In_Tree.First_Source := Id;
+
+ -- Add the source to the project list
+
+ Source := Data.Last_Source;
+
+ if Source = No_Source then
+ Data.First_Source := Id;
+ else
+ In_Tree.Sources.Table (Source).Next_In_Project := Id;
+ end if;
+
+ Data.Last_Source := Id;
+
+ -- Add the source to the language list
+
+ In_Tree.Sources.Table (Id).Next_In_Lang :=
+ In_Tree.Languages_Data.Table (Language).First_Source;
+ In_Tree.Languages_Data.Table (Language).First_Source := Id;
+ end Add_Source;
+
-------------------
-- ALI_File_Name --
-------------------
Data : Project_Data := In_Tree.Projects.Table (Project);
Extending : Boolean := False;
+ Lang_Proc_Pkg : Package_Id;
+ Linker_Name : Variable_Value;
+
begin
Nmsc.When_No_Sources := When_No_Sources;
Error_Report := Report_Error;
Recursive_Dirs.Reset;
+ Check_If_Externally_Built (Project, In_Tree, Data);
+
-- Object, exec and source directories
Get_Directories (Project, In_Tree, Data);
-- Get the programming languages
- Check_Programming_Languages (In_Tree, Data);
+ Check_Programming_Languages (In_Tree, Project, Data);
+
+ -- Check configuration in multi language mode
+
+ if Get_Mode = Multi_Language then
+ Check_Configuration (Project, In_Tree, Data);
+ end if;
-- Library attributes
Check_Library_Attributes (Project, In_Tree, Data);
- Check_If_Externally_Built (Project, In_Tree, Data);
-
if Current_Verbosity = High then
- Show_Source_Dirs (Project, In_Tree);
+ Show_Source_Dirs (Data, In_Tree);
end if;
Check_Package_Naming (Project, In_Tree, Data);
Extending := Data.Extends /= No_Project;
- Check_Naming_Scheme (Data, Project, In_Tree);
+ Check_Naming_Schemes (Data, Project, In_Tree);
- Prepare_Ada_Naming_Exceptions
- (Data.Naming.Bodies, In_Tree, Body_Part);
- Prepare_Ada_Naming_Exceptions
- (Data.Naming.Specs, In_Tree, Specification);
+ if Get_Mode = Ada_Only then
+ Prepare_Ada_Naming_Exceptions
+ (Data.Naming.Bodies, In_Tree, Body_Part);
+ Prepare_Ada_Naming_Exceptions
+ (Data.Naming.Specs, In_Tree, Specification);
+ end if;
-- Find the sources
if Data.Source_Dirs /= Nil_String then
Look_For_Sources (Project, In_Tree, Data, Follow_Links);
- end if;
- if Data.Ada_Sources_Present then
+ if Get_Mode = Ada_Only then
+
+ -- Check that all individual naming conventions apply to sources
+ -- of this project file.
+
+ Warn_If_Not_Sources
+ (Project, In_Tree, Data.Naming.Bodies,
+ Specs => False,
+ Extending => Extending);
+ Warn_If_Not_Sources
+ (Project, In_Tree, Data.Naming.Specs,
+ Specs => True,
+ Extending => Extending);
- -- Check that all individual naming conventions apply to sources of
- -- this project file.
+ elsif Get_Mode = Multi_Language and then
+ (not Data.Externally_Built) and then
+ (not Extending)
+ then
+ declare
+ Language : Language_Index;
+ Source : Source_Id;
+ Src_Data : Source_Data;
+ Alt_Lang : Alternate_Language_Id;
+ Alt_Lang_Data : Alternate_Language_Data;
+
+ begin
+ Language := Data.First_Language_Processing;
+ while Language /= No_Language_Index loop
+ Source := Data.First_Source;
+ Source_Loop : while Source /= No_Source loop
+ Src_Data := In_Tree.Sources.Table (Source);
+
+ exit Source_Loop when Src_Data.Language = Language;
+
+ Alt_Lang := Src_Data.Alternate_Languages;
+
+ Alternate_Loop :
+ while Alt_Lang /= No_Alternate_Language loop
+ Alt_Lang_Data :=
+ In_Tree.Alt_Langs.Table (Alt_Lang);
+ exit Source_Loop
+ when Alt_Lang_Data.Language = Language;
+ Alt_Lang := Alt_Lang_Data.Next;
+ end loop Alternate_Loop;
+
+ Source := Src_Data.Next_In_Project;
+ end loop Source_Loop;
+
+ if Source = No_Source then
+ Report_No_Sources
+ (Project,
+ Get_Name_String
+ (In_Tree.Languages_Data.Table
+ (Language).Display_Name),
+ In_Tree,
+ Data.Location);
+ end if;
- Warn_If_Not_Sources
- (Project, In_Tree, Data.Naming.Bodies,
- Specs => False,
- Extending => Extending);
- Warn_If_Not_Sources
- (Project, In_Tree, Data.Naming.Specs,
- Specs => True,
- Extending => Extending);
+ Language := In_Tree.Languages_Data.Table (Language).Next;
+ end loop;
+ end;
+ end if;
end if;
-- If it is a library project file, check if it is a standalone library
Get_Mains (Project, In_Tree, Data);
+ -- In multi-language mode, check if there is a linker specified
+
+ if Get_Mode = Multi_Language then
+ Lang_Proc_Pkg :=
+ Value_Of (Name_Language_Processing, Data.Decl.Packages, In_Tree);
+
+ if Lang_Proc_Pkg /= No_Package then
+ Linker_Name :=
+ Value_Of
+ (Variable_Name => Name_Linker,
+ In_Variables =>
+ In_Tree.Packages.Table (Lang_Proc_Pkg).Decl.Attributes,
+ In_Tree => In_Tree);
+
+ if Linker_Name /= Nil_Variable_Value then
+ Get_Name_String (Linker_Name.Value);
+
+ if Name_Len > 0 then
+ -- A non empty linker name was specified
+
+ Data.Linker_Name := File_Name_Type (Linker_Name.Value);
+
+ end if;
+ end if;
+ end if;
+ end if;
+
-- Update the project data in the Projects table
In_Tree.Projects.Table (Project) := Data;
Real_Name := Name_Find;
- -- Check first that the given name is not an Ada reserved word
+ -- Check first that the given name is not an Ada 95 reserved word. The
+ -- reason for the Ada 95 here is that we do not want to exclude the case
+ -- of an Ada 95 unit called Interface (for example). In Ada 2005, such
+ -- a unit name would be rejected anyway by the compiler, so there is no
+ -- requirement that the project file parser reject this.
if Get_Name_Table_Byte (Real_Name) /= 0
and then Real_Name /= Name_Project
and then Real_Name /= Name_Extends
and then Real_Name /= Name_External
+ and then Real_Name not in Ada_2005_Reserved_Words
then
Unit := No_Name;
Get_Name_String
(Naming.Dot_Replacement);
- Spec_Suffix : constant String :=
- Get_Name_String
- (Naming.Ada_Spec_Suffix);
+ Spec_Suffix : constant String :=
+ Spec_Suffix_Of (In_Tree, "ada", Naming);
- Body_Suffix : constant String :=
- Get_Name_String
- (Naming.Ada_Body_Suffix);
+ Body_Suffix : constant String :=
+ Body_Suffix_Of (In_Tree, "ada", Naming);
Separate_Suffix : constant String :=
Get_Name_String
if Is_Illegal_Suffix
(Spec_Suffix, Dot_Replacement = ".")
then
- Err_Vars.Error_Msg_File_1 := Naming.Ada_Spec_Suffix;
+ Err_Vars.Error_Msg_File_1 :=
+ Spec_Suffix_Id_Of (In_Tree, "ada", Naming);
Error_Msg
(Project, In_Tree,
"{ is illegal for Spec_Suffix",
- Naming.Spec_Suffix_Loc);
+ Naming.Ada_Spec_Suffix_Loc);
end if;
- if Is_Illegal_Suffix (Body_Suffix, Dot_Replacement = ".") then
- Err_Vars.Error_Msg_File_1 := Naming.Ada_Body_Suffix;
+ if Is_Illegal_Suffix
+ (Body_Suffix, Dot_Replacement = ".")
+ then
+ Err_Vars.Error_Msg_File_1 :=
+ Body_Suffix_Id_Of (In_Tree, "ada", Naming);
Error_Msg
(Project, In_Tree,
"{ is illegal for Body_Suffix",
- Naming.Body_Suffix_Loc);
+ Naming.Ada_Body_Suffix_Loc);
end if;
if Body_Suffix /= Separate_Suffix then
if Is_Illegal_Suffix
- (Separate_Suffix, Dot_Replacement = ".")
+ (Separate_Suffix, Dot_Replacement = ".")
then
Err_Vars.Error_Msg_File_1 := Naming.Separate_Suffix;
Error_Msg
""") cannot end with" &
" Spec_Suffix (""" &
Spec_Suffix & """).",
- Naming.Body_Suffix_Loc);
+ Naming.Ada_Body_Suffix_Loc);
end if;
if Body_Suffix /= Separate_Suffix
end if;
end Check_Ada_Naming_Scheme_Validity;
+ -------------------------
+ -- Check_Configuration --
+ -------------------------
+
+ procedure Check_Configuration
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data)
+ is
+ Compiler_Pkg : constant Package_Id :=
+ Value_Of (Name_Compiler, Data.Decl.Packages, In_Tree);
+ Binder_Pkg : constant Package_Id :=
+ Value_Of (Name_Binder, Data.Decl.Packages, In_Tree);
+ Element : Package_Element;
+
+ Arrays : Array_Id;
+ Current_Array : Array_Data;
+ Arr_Elmt_Id : Array_Element_Id;
+ Arr_Element : Array_Element;
+ List : String_List_Id;
+
+ Current_Language_Index : Language_Index;
+
+ procedure Get_Language (Name : Name_Id);
+ -- Check if this is the name of a language of the project and
+ -- set Current_Language_Index accordingly.
+
+ ------------------
+ -- Get_Language --
+ ------------------
+
+ procedure Get_Language (Name : Name_Id) is
+ Real_Language : Name_Id;
+
+ begin
+ Get_Name_String (Name);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Real_Language := Name_Find;
+
+ Current_Language_Index := Data.First_Language_Processing;
+ loop
+ exit when Current_Language_Index = No_Language_Index or else
+ In_Tree.Languages_Data.Table (Current_Language_Index).Name =
+ Real_Language;
+ Current_Language_Index :=
+ In_Tree.Languages_Data.Table (Current_Language_Index).Next;
+ end loop;
+ end Get_Language;
+
+ -- Start of processing for Check_Configuration
+
+ begin
+ if Compiler_Pkg /= No_Package then
+ Element := In_Tree.Packages.Table (Compiler_Pkg);
+
+ Arrays := Element.Decl.Arrays;
+ while Arrays /= No_Array loop
+ Current_Array := In_Tree.Arrays.Table (Arrays);
+
+ Arr_Elmt_Id := Current_Array.Value;
+ while Arr_Elmt_Id /= No_Array_Element loop
+ Arr_Element := In_Tree.Array_Elements.Table (Arr_Elmt_Id);
+ Get_Language (Arr_Element.Index);
+
+ if Current_Language_Index /= No_Language_Index then
+ case Current_Array.Name is
+ when Name_Dependency_Switches =>
+ List := Arr_Element.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project, In_Tree,
+ "dependency option cannot be null",
+ Arr_Element.Value.Location);
+ end if;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index)
+ .Config.Dependency_Option,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Dependency_Driver =>
+
+ -- Attribute Dependency_Driver (<language>)
+
+ List := Arr_Element.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project, In_Tree,
+ "compute dependency cannot be null",
+ Arr_Element.Value.Location);
+ end if;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index)
+ .Config.Compute_Dependency,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Include_Option =>
+
+ -- Attribute Include_Option (<language>)
+
+ List := Arr_Element.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project, In_Tree,
+ "include option cannot be null",
+ Arr_Element.Value.Location);
+ end if;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Include_Option,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Include_Path =>
+
+ -- Attribute Include_Path (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Include_Path :=
+ Arr_Element.Value.Value;
+
+ when Name_Include_Path_File =>
+
+ -- Attribute Include_Path_File (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Include_Path_File :=
+ Arr_Element.Value.Value;
+
+ when Name_Driver =>
+
+ -- Attribute Driver (<language>)
+
+ Get_Name_String (Arr_Element.Value.Value);
+
+ if Name_Len = 0 then
+ Error_Msg
+ (Project, In_Tree,
+ "compiler driver name cannot be empty",
+ Arr_Element.Value.Location);
+ end if;
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Compiler_Driver :=
+ File_Name_Type (Arr_Element.Value.Value);
+
+ when Name_Switches =>
+
+ -- Attribute Minimum_Compiler_Options (<language>)
+
+ List := Arr_Element.Value.Values;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.
+ Compiler_Min_Options,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Pic_Option =>
+
+ -- Attribute Pic_Option (<language>)
+
+ List := Arr_Element.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project, In_Tree,
+ "compiler PIC option cannot be null",
+ Arr_Element.Value.Location);
+ end if;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.
+ Compilation_PIC_Option,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Mapping_File_Switches =>
+
+ -- Attribute Mapping_File_Switches (<language>)
+
+ List := Arr_Element.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project, In_Tree,
+ "mapping file switches cannot be null",
+ Arr_Element.Value.Location);
+ end if;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.
+ Mapping_File_Switches,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Mapping_Spec_Suffix =>
+
+ -- Attribute Mapping_Spec_Suffix (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index)
+ .Config.Mapping_Spec_Suffix :=
+ File_Name_Type (Arr_Element.Value.Value);
+
+ when Name_Mapping_Body_Suffix =>
+
+ -- Attribute Mapping_Body_Suffix (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index)
+ .Config.Mapping_Body_Suffix :=
+ File_Name_Type (Arr_Element.Value.Value);
+
+ when Name_Config_File_Switches =>
+
+ -- Attribute Config_File_Switches (<language>)
+
+ List := Arr_Element.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project, In_Tree,
+ "config file switches cannot be null",
+ Arr_Element.Value.Location);
+ end if;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.
+ Config_File_Switches,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Config_Body_File_Name =>
+
+ -- Attribute Config_Body_File_Name (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Config_Body :=
+ Arr_Element.Value.Value;
+
+ when Name_Config_Body_File_Name_Pattern =>
+
+ -- Attribute Config_Body_File_Name_Pattern
+ -- (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index)
+ .Config.Config_Body_Pattern :=
+ Arr_Element.Value.Value;
+
+ when Name_Config_Spec_File_Name =>
+
+ -- Attribute Config_Spec_File_Name (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Config_Spec :=
+ Arr_Element.Value.Value;
+
+ when Name_Config_Spec_File_Name_Pattern =>
+
+ -- Attribute Config_Spec_File_Name_Pattern
+ -- (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index)
+ .Config.Config_Spec_Pattern :=
+ Arr_Element.Value.Value;
+
+ when Name_Config_File_Unique =>
+
+ -- Attribute Config_File_Unique (<language>)
+
+ begin
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index)
+ .Config.Config_File_Unique :=
+ Boolean'Value
+ (Get_Name_String (Arr_Element.Value.Value));
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Project, In_Tree,
+ "illegal value gor Config_File_Unique",
+ Arr_Element.Value.Location);
+ end;
+
+ when others =>
+ null;
+ end case;
+ end if;
+
+ Arr_Elmt_Id := Arr_Element.Next;
+ end loop;
+
+ Arrays := Current_Array.Next;
+ end loop;
+ end if;
+
+ -- Comment needed here ???
+
+ if Binder_Pkg /= No_Package then
+ Element := In_Tree.Packages.Table (Binder_Pkg);
+ Arrays := Element.Decl.Arrays;
+ while Arrays /= No_Array loop
+ Current_Array := In_Tree.Arrays.Table (Arrays);
+
+ Arr_Elmt_Id := Current_Array.Value;
+ while Arr_Elmt_Id /= No_Array_Element loop
+ Arr_Element := In_Tree.Array_Elements.Table (Arr_Elmt_Id);
+
+ Get_Language (Arr_Element.Index);
+
+ if Current_Language_Index /= No_Language_Index then
+ case Current_Array.Name is
+ when Name_Driver =>
+
+ -- Attribute Driver (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Binder_Driver :=
+ File_Name_Type (Arr_Element.Value.Value);
+
+ when Name_Objects_Path =>
+
+ -- Attribute Objects_Path (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Objects_Path :=
+ Arr_Element.Value.Value;
+
+ when Name_Objects_Path_File =>
+
+ -- Attribute Objects_Path_File (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Objects_Path_File :=
+ Arr_Element.Value.Value;
+
+ when Name_Prefix =>
+
+ -- Attribute Prefix (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Current_Language_Index).Config.Binder_Prefix :=
+ Arr_Element.Value.Value;
+
+ when others =>
+ null;
+ end case;
+ end if;
+
+ Arr_Elmt_Id := Arr_Element.Next;
+ end loop;
+
+ Arrays := Current_Array.Next;
+ end loop;
+ end if;
+ end Check_Configuration;
+
----------------------
-- Check_For_Source --
----------------------
procedure Check_For_Source
(File_Name : File_Name_Type;
- Path_Name : File_Name_Type;
+ Path_Name : Path_Name_Type;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
end Check_If_Externally_Built;
-----------------------------
- -- Check_Naming_Scheme --
+ -- Check_Naming_Schemes --
-----------------------------
- procedure Check_Naming_Scheme
+ procedure Check_Naming_Schemes
(Data : in out Project_Data;
Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
Naming_Id : constant Package_Id :=
Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
-
- Naming : Package_Element;
+ Naming : Package_Element;
procedure Check_Unit_Names (List : Array_Element_Id);
-- Check that a list of unit names contains only valid names
+ procedure Get_Exceptions (Kind : Source_Kind);
+
+ procedure Get_Unit_Exceptions (Kind : Source_Kind);
+
----------------------
-- Check_Unit_Names --
----------------------
procedure Check_Unit_Names (List : Array_Element_Id) is
- Current : Array_Element_Id := List;
+ Current : Array_Element_Id;
Element : Array_Element;
Unit_Name : Name_Id;
begin
-- Loop through elements of the string list
+ Current := List;
while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current);
Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
if Unit_Name = No_Name then
- Error_Msg_Name_1 := Element.Index;
- -- Errutil.Set_Msg_Txt ignores '$' (unit name insertion)
+ Err_Vars.Error_Msg_Name_1 := Element.Index;
Error_Msg
(Project, In_Tree,
"%% is not a valid unit name.",
end loop;
end Check_Unit_Names;
- -- Start of processing for Check_Naming_Scheme
+ --------------------
+ -- Get_Exceptions --
+ --------------------
- begin
- -- If there is a package Naming, we will put in Data.Naming what is in
- -- this package Naming.
+ procedure Get_Exceptions (Kind : Source_Kind) is
+ Exceptions : Array_Element_Id;
+ Exception_List : Variable_Value;
+ Element_Id : String_List_Id;
+ Element : String_Element;
+ File_Name : File_Name_Type;
+ Lang_Id : Language_Index;
+ Lang : Name_Id;
+ Source : Source_Id;
- if Naming_Id /= No_Package then
- Naming := In_Tree.Packages.Table (Naming_Id);
+ begin
+ if Kind = Impl then
+ Exceptions :=
+ Value_Of
+ (Name_Implementation_Exceptions,
+ In_Arrays => Naming.Decl.Arrays,
+ In_Tree => In_Tree);
- if Current_Verbosity = High then
- Write_Line ("Checking ""Naming"" for Ada.");
+ else
+ Exceptions :=
+ Value_Of
+ (Name_Specification_Exceptions,
+ In_Arrays => Naming.Decl.Arrays,
+ In_Tree => In_Tree);
end if;
- declare
- Bodies : constant Array_Element_Id :=
- Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree);
+ Lang_Id := Data.First_Language_Processing;
+ while Lang_Id /= No_Language_Index loop
+ if In_Tree.Languages_Data.Table (Lang_Id).Config.Kind =
+ File_Based
+ then
+ Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
- Specs : constant Array_Element_Id :=
- Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree);
+ Exception_List := Value_Of
+ (Index => Lang,
+ In_Array => Exceptions,
+ In_Tree => In_Tree);
- begin
- if Bodies /= No_Array_Element then
+ if Exception_List /= Nil_Variable_Value then
+ Element_Id := Exception_List.Values;
- -- We have elements in the array Body_Part
+ while Element_Id /= Nil_String loop
+ Element :=
+ In_Tree.String_Elements.Table (Element_Id);
+ Get_Name_String (Element.Value);
+ Canonical_Case_File_Name
+ (Name_Buffer (1 .. Name_Len));
+ File_Name := Name_Find;
- if Current_Verbosity = High then
- Write_Line ("Found Bodies.");
- end if;
+ Source := Data.First_Source;
+ while Source /= No_Source
+ and then
+ In_Tree.Sources.Table (Source).File /= File_Name
+ loop
+ Source :=
+ In_Tree.Sources.Table (Source).Next_In_Project;
+ end loop;
- Data.Naming.Bodies := Bodies;
- Check_Unit_Names (Bodies);
+ if Source = No_Source then
- else
- if Current_Verbosity = High then
- Write_Line ("No Bodies.");
+ -- This is a new source. Create an entry for it
+ -- in the Sources table.
+
+ Source_Data_Table.Increment_Last (In_Tree.Sources);
+ Source := Source_Data_Table.Last (In_Tree.Sources);
+
+ if Current_Verbosity = High then
+ Write_Str ("Adding source #");
+ Write_Str (Source'Img);
+ Write_Str (", File : ");
+ Write_Line (Get_Name_String (File_Name));
+ end if;
+
+ declare
+ Src_Data : Source_Data := No_Source_Data;
+ begin
+ Src_Data.Project := Project;
+ Src_Data.Language_Name := Lang;
+ Src_Data.Language := Lang_Id;
+ Src_Data.Kind := Kind;
+ Src_Data.File := File_Name;
+ Src_Data.Display_File :=
+ File_Name_Type (Element.Value);
+ Src_Data.Object := Object_Name (File_Name);
+ Src_Data.Dependency :=
+ In_Tree.Languages_Data.Table
+ (Lang_Id).Config.Dependency_Kind;
+ Src_Data.Dep_Name :=
+ Dependency_Name (File_Name, Src_Data.Dependency);
+ Src_Data.Switches := Switches_Name (File_Name);
+ Src_Data.Naming_Exception := True;
+ In_Tree.Sources.Table (Source) := Src_Data;
+ end;
+
+ Add_Source (Source, Data, In_Tree);
+
+ else
+ -- Check if the file name is already recorded for
+ -- another language or another kind.
+
+ if
+ In_Tree.Sources.Table (Source).Language /= Lang_Id
+ then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "the same file cannot be a source " &
+ "of two languages",
+ Element.Location);
+
+ elsif In_Tree.Sources.Table (Source).Kind /= Kind then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "the same file cannot be a source " &
+ "and a template",
+ Element.Location);
+ end if;
+
+ -- If the file is already recorded for the same
+ -- language and the same kind, it means that the file
+ -- name appears several times in the *_Exceptions
+ -- attribute; so there is nothing to do.
+
+ end if;
+
+ Element_Id := Element.Next;
+ end loop;
end if;
end if;
- if Specs /= No_Array_Element then
+ Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
+ end loop;
+ end Get_Exceptions;
- -- We have elements in the array Specs
+ -------------------------
+ -- Get_Unit_Exceptions --
+ -------------------------
- if Current_Verbosity = High then
- Write_Line ("Found Specs.");
- end if;
+ procedure Get_Unit_Exceptions (Kind : Source_Kind) is
+ Exceptions : Array_Element_Id;
+ Element : Array_Element;
+ Unit : Name_Id;
+ Index : Int;
+ File_Name : File_Name_Type;
+ Lang_Id : constant Language_Index :=
+ Data.Unit_Based_Language_Index;
+ Lang : constant Name_Id :=
+ Data.Unit_Based_Language_Name;
- Data.Naming.Specs := Specs;
- Check_Unit_Names (Specs);
+ Source : Source_Id;
+ Source_To_Replace : Source_Id := No_Source;
- else
- if Current_Verbosity = High then
- Write_Line ("No Specs.");
- end if;
+ Other_Project : Project_Id;
+ Other_Part : Source_Id;
+
+ begin
+ if Lang_Id = No_Language_Index or else Lang = No_Name then
+ return;
+ end if;
+
+ if Kind = Impl then
+ Exceptions := Value_Of
+ (Name_Body,
+ In_Arrays => Naming.Decl.Arrays,
+ In_Tree => In_Tree);
+
+ if Exceptions = No_Array_Element then
+ Exceptions :=
+ Value_Of
+ (Name_Implementation,
+ In_Arrays => Naming.Decl.Arrays,
+ In_Tree => In_Tree);
end if;
- end;
- -- We are now checking if variables Dot_Replacement, Casing,
- -- Spec_Suffix, Body_Suffix and/or Separate_Suffix
- -- exist.
+ else
+ Exceptions :=
+ Value_Of
+ (Name_Spec,
+ In_Arrays => Naming.Decl.Arrays,
+ In_Tree => In_Tree);
- -- For each variable, if it does not exist, we do nothing,
- -- because we already have the default.
+ if Exceptions = No_Array_Element then
+ Exceptions := Value_Of
+ (Name_Specification,
+ In_Arrays => Naming.Decl.Arrays,
+ In_Tree => In_Tree);
+ end if;
- -- Check Dot_Replacement
+ end if;
- declare
- Dot_Replacement : constant Variable_Value :=
- Util.Value_Of
- (Name_Dot_Replacement,
- Naming.Decl.Attributes, In_Tree);
+ while Exceptions /= No_Array_Element loop
+ Element := In_Tree.Array_Elements.Table (Exceptions);
- begin
- pragma Assert (Dot_Replacement.Kind = Single,
- "Dot_Replacement is not a single string");
+ Get_Name_String (Element.Value.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ File_Name := Name_Find;
+
+ Get_Name_String (Element.Index);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Unit := Name_Find;
- if not Dot_Replacement.Default then
- Get_Name_String (Dot_Replacement.Value);
+ Index := Element.Value.Index;
- if Name_Len = 0 then
+ -- For Ada, check if it is a valid unit name
+
+ if Lang = Name_Ada then
+ Get_Name_String (Element.Index);
+ Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
+
+ if Unit = No_Name then
+ Err_Vars.Error_Msg_Name_1 := Element.Index;
Error_Msg
(Project, In_Tree,
- "Dot_Replacement cannot be empty",
- Dot_Replacement.Location);
-
- else
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Data.Naming.Dot_Replacement := Name_Find;
- Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
+ "%% is not a valid unit name.",
+ Element.Value.Location);
end if;
end if;
- end;
- if Current_Verbosity = High then
- Write_Str (" Dot_Replacement = """);
- Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
- Write_Char ('"');
- Write_Eol;
- end if;
+ if Unit /= No_Name then
- -- Check Casing
+ -- Check if the source already exists
- declare
- Casing_String : constant Variable_Value :=
- Util.Value_Of
- (Name_Casing, Naming.Decl.Attributes, In_Tree);
+ Source := In_Tree.First_Source;
+ Source_To_Replace := No_Source;
- begin
- pragma Assert (Casing_String.Kind = Single,
- "Casing is not a single string");
+ while Source /= No_Source and then
+ (In_Tree.Sources.Table (Source).Unit /= Unit or else
+ In_Tree.Sources.Table (Source).Index /= Index)
+ loop
+ Source := In_Tree.Sources.Table (Source).Next_In_Sources;
+ end loop;
- if not Casing_String.Default then
- declare
- Casing_Image : constant String :=
- Get_Name_String (Casing_String.Value);
- begin
- declare
- Casing_Value : constant Casing_Type :=
- Value (Casing_Image);
- begin
- Data.Naming.Casing := Casing_Value;
- end;
+ if Source /= No_Source then
+ if In_Tree.Sources.Table (Source).Kind /= Kind then
+ Other_Part := Source;
- exception
- when Constraint_Error =>
- if Casing_Image'Length = 0 then
- Error_Msg
- (Project, In_Tree,
- "Casing cannot be an empty string",
- Casing_String.Location);
+ loop
+ Source :=
+ In_Tree.Sources.Table (Source).Next_In_Sources;
+
+ exit when Source = No_Source or else
+ (In_Tree.Sources.Table (Source).Unit = Unit
+ and then
+ In_Tree.Sources.Table (Source).Index = Index);
+ end loop;
+ end if;
+
+ if Source /= No_Source then
+ Other_Project := In_Tree.Sources.Table (Source).Project;
+
+ if Is_Extending (Project, Other_Project, In_Tree) then
+ Other_Part :=
+ In_Tree.Sources.Table (Source).Other_Part;
+
+ -- Record the source to be removed
+
+ Source_To_Replace := Source;
+ Source := No_Source;
else
- Name_Len := Casing_Image'Length;
- Name_Buffer (1 .. Name_Len) := Casing_Image;
- Err_Vars.Error_Msg_Name_1 := Name_Find;
+ Error_Msg_Name_1 := Unit;
+
Error_Msg
- (Project, In_Tree,
- "%% is not a correct Casing",
- Casing_String.Location);
+ (Project,
+ In_Tree,
+ "unit%% cannot belong to two projects " &
+ "simultaneously",
+ Element.Value.Location);
end if;
- end;
+ end if;
+ end if;
+
+ if Source = No_Source then
+ Source_Data_Table.Increment_Last (In_Tree.Sources);
+ Source := Source_Data_Table.Last (In_Tree.Sources);
+
+ if Current_Verbosity = High then
+ Write_Str ("Adding source #");
+ Write_Str (Source'Img);
+ Write_Str (", File : ");
+ Write_Str (Get_Name_String (File_Name));
+ Write_Str (", Unit : ");
+ Write_Line (Get_Name_String (Unit));
+ end if;
+
+ declare
+ Src_Data : Source_Data := No_Source_Data;
+
+ begin
+ Src_Data.Project := Project;
+ Src_Data.Language_Name := Lang;
+ Src_Data.Language := Lang_Id;
+ Src_Data.Kind := Kind;
+ Src_Data.Other_Part := Other_Part;
+ Src_Data.Unit := Unit;
+ Src_Data.Index := Index;
+ Src_Data.File := File_Name;
+ Src_Data.Object := Object_Name (File_Name);
+ Src_Data.Display_File :=
+ File_Name_Type (Element.Value.Value);
+ Src_Data.Dependency := In_Tree.Languages_Data.Table
+ (Lang_Id).Config.Dependency_Kind;
+ Src_Data.Dep_Name :=
+ Dependency_Name (File_Name, Src_Data.Dependency);
+ Src_Data.Switches := Switches_Name (File_Name);
+ Src_Data.Naming_Exception := True;
+ In_Tree.Sources.Table (Source) := Src_Data;
+ end;
+
+ Add_Source (Source, Data, In_Tree);
+
+ if Source_To_Replace /= No_Source then
+ Remove_Source
+ (Source_To_Replace, Source, Project, Data, In_Tree);
+ end if;
+ end if;
end if;
- end;
- if Current_Verbosity = High then
- Write_Str (" Casing = ");
- Write_Str (Image (Data.Naming.Casing));
- Write_Char ('.');
- Write_Eol;
- end if;
+ Exceptions := Element.Next;
+ end loop;
- -- Check Spec_Suffix
+ end Get_Unit_Exceptions;
- declare
- Ada_Spec_Suffix : constant Variable_Value :=
- Prj.Util.Value_Of
- (Index => Name_Ada,
- Src_Index => 0,
- In_Array => Data.Naming.Spec_Suffix,
- In_Tree => In_Tree);
+ -- Start of processing for Check_Naming_Schemes
- begin
- if Ada_Spec_Suffix.Kind = Single
- and then Get_Name_String (Ada_Spec_Suffix.Value) /= ""
- then
- Get_Name_String (Ada_Spec_Suffix.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Data.Naming.Ada_Spec_Suffix := Name_Find;
- Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
+ begin
+ if Get_Mode = Ada_Only then
- else
- Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
+ -- If there is a package Naming, we will put in Data.Naming what is
+ -- in this package Naming.
+
+ if Naming_Id /= No_Package then
+ Naming := In_Tree.Packages.Table (Naming_Id);
+
+ if Current_Verbosity = High then
+ Write_Line ("Checking ""Naming"" for Ada.");
end if;
- end;
- if Current_Verbosity = High then
- Write_Str (" Spec_Suffix = """);
- Write_Str (Get_Name_String (Data.Naming.Ada_Spec_Suffix));
- Write_Char ('"');
- Write_Eol;
- end if;
+ declare
+ Bodies : constant Array_Element_Id :=
+ Util.Value_Of
+ (Name_Body, Naming.Decl.Arrays, In_Tree);
- -- Check Body_Suffix
+ Specs : constant Array_Element_Id :=
+ Util.Value_Of
+ (Name_Spec, Naming.Decl.Arrays, In_Tree);
- declare
- Ada_Body_Suffix : constant Variable_Value :=
- Prj.Util.Value_Of
- (Index => Name_Ada,
- Src_Index => 0,
- In_Array => Data.Naming.Body_Suffix,
- In_Tree => In_Tree);
+ begin
+ if Bodies /= No_Array_Element then
- begin
- if Ada_Body_Suffix.Kind = Single
- and then Get_Name_String (Ada_Body_Suffix.Value) /= ""
- then
- Get_Name_String (Ada_Body_Suffix.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Data.Naming.Ada_Body_Suffix := Name_Find;
- Data.Naming.Body_Suffix_Loc := Ada_Body_Suffix.Location;
+ -- We have elements in the array Body_Part
- else
- Data.Naming.Ada_Body_Suffix := Default_Ada_Body_Suffix;
+ if Current_Verbosity = High then
+ Write_Line ("Found Bodies.");
+ end if;
+
+ Data.Naming.Bodies := Bodies;
+ Check_Unit_Names (Bodies);
+
+ else
+ if Current_Verbosity = High then
+ Write_Line ("No Bodies.");
+ end if;
+ end if;
+
+ if Specs /= No_Array_Element then
+
+ -- We have elements in the array Specs
+
+ if Current_Verbosity = High then
+ Write_Line ("Found Specs.");
+ end if;
+
+ Data.Naming.Specs := Specs;
+ Check_Unit_Names (Specs);
+
+ else
+ if Current_Verbosity = High then
+ Write_Line ("No Specs.");
+ end if;
+ end if;
+ end;
+
+ -- We are now checking if variables Dot_Replacement, Casing,
+ -- Spec_Suffix, Body_Suffix and/or Separate_Suffix exist.
+
+ -- For each variable, if it does not exist, we do nothing,
+ -- because we already have the default.
+
+ -- Check Dot_Replacement
+
+ declare
+ Dot_Replacement : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Dot_Replacement,
+ Naming.Decl.Attributes, In_Tree);
+
+ begin
+ pragma Assert (Dot_Replacement.Kind = Single,
+ "Dot_Replacement is not a single string");
+
+ if not Dot_Replacement.Default then
+ Get_Name_String (Dot_Replacement.Value);
+
+ if Name_Len = 0 then
+ Error_Msg
+ (Project, In_Tree,
+ "Dot_Replacement cannot be empty",
+ Dot_Replacement.Location);
+
+ else
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Data.Naming.Dot_Replacement := Name_Find;
+ Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
+ end if;
+ end if;
+ end;
+
+ if Current_Verbosity = High then
+ Write_Str (" Dot_Replacement = """);
+ Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
+ Write_Char ('"');
+ Write_Eol;
end if;
- end;
- if Current_Verbosity = High then
- Write_Str (" Body_Suffix = """);
- Write_Str (Get_Name_String (Data.Naming.Ada_Body_Suffix));
- Write_Char ('"');
- Write_Eol;
- end if;
+ -- Check Casing
+
+ declare
+ Casing_String : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Casing,
+ Naming.Decl.Attributes,
+ In_Tree);
- -- Check Separate_Suffix
+ begin
+ pragma Assert (Casing_String.Kind = Single,
+ "Casing is not a single string");
- declare
- Ada_Sep_Suffix : constant Variable_Value :=
- Prj.Util.Value_Of
- (Variable_Name => Name_Separate_Suffix,
- In_Variables => Naming.Decl.Attributes,
- In_Tree => In_Tree);
+ if not Casing_String.Default then
+ declare
+ Casing_Image : constant String :=
+ Get_Name_String (Casing_String.Value);
+ begin
+ declare
+ Casing_Value : constant Casing_Type :=
+ Value (Casing_Image);
+ begin
+ Data.Naming.Casing := Casing_Value;
+ end;
- begin
- if Ada_Sep_Suffix.Default then
- Data.Naming.Separate_Suffix :=
- Data.Naming.Ada_Body_Suffix;
+ exception
+ when Constraint_Error =>
+ if Casing_Image'Length = 0 then
+ Error_Msg
+ (Project, In_Tree,
+ "Casing cannot be an empty string",
+ Casing_String.Location);
- else
- Get_Name_String (Ada_Sep_Suffix.Value);
+ else
+ Name_Len := Casing_Image'Length;
+ Name_Buffer (1 .. Name_Len) := Casing_Image;
+ Err_Vars.Error_Msg_Name_1 := Name_Find;
+ Error_Msg
+ (Project, In_Tree,
+ "%% is not a correct Casing",
+ Casing_String.Location);
+ end if;
+ end;
+ end if;
+ end;
- if Name_Len = 0 then
- Error_Msg
- (Project, In_Tree,
- "Separate_Suffix cannot be empty",
- Ada_Sep_Suffix.Location);
+ if Current_Verbosity = High then
+ Write_Str (" Casing = ");
+ Write_Str (Image (Data.Naming.Casing));
+ Write_Char ('.');
+ Write_Eol;
+ end if;
+
+ -- Check Spec_Suffix
+
+ declare
+ Ada_Spec_Suffix : constant Variable_Value :=
+ Prj.Util.Value_Of
+ (Index => Name_Ada,
+ Src_Index => 0,
+ In_Array => Data.Naming.Spec_Suffix,
+ In_Tree => In_Tree);
+
+ begin
+ if Ada_Spec_Suffix.Kind = Single
+ and then Get_Name_String (Ada_Spec_Suffix.Value) /= ""
+ then
+ Get_Name_String (Ada_Spec_Suffix.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Name_Find);
+ Data.Naming.Ada_Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
else
+ Set_Spec_Suffix
+ (In_Tree,
+ "ada",
+ Data.Naming,
+ Default_Ada_Spec_Suffix);
+ end if;
+ end;
+
+ if Current_Verbosity = High then
+ Write_Str (" Spec_Suffix = """);
+ Write_Str (Spec_Suffix_Of (In_Tree, "ada", Data.Naming));
+ Write_Char ('"');
+ Write_Eol;
+ end if;
+
+ -- Check Body_Suffix
+
+ declare
+ Ada_Body_Suffix : constant Variable_Value :=
+ Prj.Util.Value_Of
+ (Index => Name_Ada,
+ Src_Index => 0,
+ In_Array => Data.Naming.Body_Suffix,
+ In_Tree => In_Tree);
+
+ begin
+ if Ada_Body_Suffix.Kind = Single
+ and then Get_Name_String (Ada_Body_Suffix.Value) /= ""
+ then
+ Get_Name_String (Ada_Body_Suffix.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Data.Naming.Separate_Suffix := Name_Find;
- Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location;
+ Set_Body_Suffix (In_Tree, "ada", Data.Naming, Name_Find);
+ Data.Naming.Ada_Body_Suffix_Loc := Ada_Body_Suffix.Location;
+
+ else
+ Set_Body_Suffix
+ (In_Tree,
+ "ada",
+ Data.Naming,
+ Default_Ada_Body_Suffix);
end if;
+ end;
+
+ if Current_Verbosity = High then
+ Write_Str (" Body_Suffix = """);
+ Write_Str (Body_Suffix_Of (In_Tree, "ada", Data.Naming));
+ Write_Char ('"');
+ Write_Eol;
end if;
- end;
- if Current_Verbosity = High then
- Write_Str (" Separate_Suffix = """);
- Write_Str (Get_Name_String (Data.Naming.Separate_Suffix));
- Write_Char ('"');
- Write_Eol;
+ -- Check Separate_Suffix
+
+ declare
+ Ada_Sep_Suffix : constant Variable_Value :=
+ Prj.Util.Value_Of
+ (Variable_Name => Name_Separate_Suffix,
+ In_Variables => Naming.Decl.Attributes,
+ In_Tree => In_Tree);
+
+ begin
+ if Ada_Sep_Suffix.Default then
+ Data.Naming.Separate_Suffix :=
+ Body_Suffix_Id_Of (In_Tree, "ada", Data.Naming);
+
+ else
+ Get_Name_String (Ada_Sep_Suffix.Value);
+
+ if Name_Len = 0 then
+ Error_Msg
+ (Project, In_Tree,
+ "Separate_Suffix cannot be empty",
+ Ada_Sep_Suffix.Location);
+
+ else
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Data.Naming.Separate_Suffix := Name_Find;
+ Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location;
+ end if;
+ end if;
+ end;
+
+ if Current_Verbosity = High then
+ Write_Str (" Separate_Suffix = """);
+ Write_Str (Get_Name_String (Data.Naming.Separate_Suffix));
+ Write_Char ('"');
+ Write_Eol;
+ end if;
+
+ -- Check if Data.Naming is valid
+
+ Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming);
end if;
- -- Check if Data.Naming is valid
+ elsif not In_Configuration then
- Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming);
+ -- Look into package Naming, if there is one
- else
- Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
- Data.Naming.Ada_Body_Suffix := Default_Ada_Body_Suffix;
- Data.Naming.Separate_Suffix := Default_Ada_Body_Suffix;
+ if Naming_Id /= No_Package then
+ Naming := In_Tree.Packages.Table (Naming_Id);
+
+ if Current_Verbosity = High then
+ Write_Line ("Checking package Naming.");
+ end if;
+
+ -- We are now checking if attribute Dot_Replacement, Casing,
+ -- and/or Separate_Suffix exist.
+
+ -- For each attribute, if it does not exist, we do nothing,
+ -- because we already have the default.
+ -- Otherwise, for all unit-based languages, we put the declared
+ -- value in the language config.
+
+ declare
+ Dot_Repl : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Dot_Replacement,
+ Naming.Decl.Attributes, In_Tree);
+ Dot_Replacement : File_Name_Type := No_File;
+
+ Casing_String : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Casing,
+ Naming.Decl.Attributes,
+ In_Tree);
+ Casing : Casing_Type;
+ Casing_Defined : Boolean := False;
+
+ Sep_Suffix : constant Variable_Value :=
+ Prj.Util.Value_Of
+ (Variable_Name => Name_Separate_Suffix,
+ In_Variables => Naming.Decl.Attributes,
+ In_Tree => In_Tree);
+ Separate_Suffix : File_Name_Type := No_File;
+
+ Lang_Id : Language_Index;
+ begin
+ -- Check attribute Dot_Replacement
+
+ if not Dot_Repl.Default then
+ Get_Name_String (Dot_Repl.Value);
+
+ if Name_Len = 0 then
+ Error_Msg
+ (Project, In_Tree,
+ "Dot_Replacement cannot be empty",
+ Dot_Repl.Location);
+
+ else
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Dot_Replacement := Name_Find;
+
+ if Current_Verbosity = High then
+ Write_Str (" Dot_Replacement = """);
+ Write_Str (Get_Name_String (Dot_Replacement));
+ Write_Char ('"');
+ Write_Eol;
+ end if;
+ end if;
+ end if;
+
+ -- Check attribute Casing
+
+ if not Casing_String.Default then
+ declare
+ Casing_Image : constant String :=
+ Get_Name_String (Casing_String.Value);
+ begin
+ declare
+ Casing_Value : constant Casing_Type :=
+ Value (Casing_Image);
+ begin
+ Casing := Casing_Value;
+ Casing_Defined := True;
+
+ if Current_Verbosity = High then
+ Write_Str (" Casing = ");
+ Write_Str (Image (Casing));
+ Write_Char ('.');
+ Write_Eol;
+ end if;
+ end;
+
+ exception
+ when Constraint_Error =>
+ if Casing_Image'Length = 0 then
+ Error_Msg
+ (Project, In_Tree,
+ "Casing cannot be an empty string",
+ Casing_String.Location);
+
+ else
+ Name_Len := Casing_Image'Length;
+ Name_Buffer (1 .. Name_Len) := Casing_Image;
+ Err_Vars.Error_Msg_Name_1 := Name_Find;
+ Error_Msg
+ (Project, In_Tree,
+ "%% is not a correct Casing",
+ Casing_String.Location);
+ end if;
+ end;
+ end if;
+
+ if not Sep_Suffix.Default then
+ Get_Name_String (Sep_Suffix.Value);
+
+ if Name_Len = 0 then
+ Error_Msg
+ (Project, In_Tree,
+ "Separate_Suffix cannot be empty",
+ Sep_Suffix.Location);
+
+ else
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Separate_Suffix := Name_Find;
+
+ if Current_Verbosity = High then
+ Write_Str (" Separate_Suffix = """);
+ Write_Str
+ (Get_Name_String (Data.Naming.Separate_Suffix));
+ Write_Char ('"');
+ Write_Eol;
+ end if;
+ end if;
+ end if;
+
+ -- For all unit based languages, if any, set the specified
+ -- value of Dot_Replacement, Casing and/or Separate_Suffix.
+
+ if Dot_Replacement /= No_File or else
+ Casing_Defined or else
+ Separate_Suffix /= No_File
+ then
+ Lang_Id := Data.First_Language_Processing;
+
+ while Lang_Id /= No_Language_Index loop
+ if In_Tree.Languages_Data.Table
+ (Lang_Id).Config.Kind = Unit_Based
+ then
+ if Dot_Replacement /= No_File then
+ In_Tree.Languages_Data.Table
+ (Lang_Id).Config.Naming_Data.Dot_Replacement :=
+ Dot_Replacement;
+ end if;
+
+ if Casing_Defined then
+ In_Tree.Languages_Data.Table
+ (Lang_Id).Config.Naming_Data.Casing := Casing;
+ end if;
+
+ if Separate_Suffix /= No_File then
+ In_Tree.Languages_Data.Table
+ (Lang_Id).Config.Naming_Data.Separate_Suffix :=
+ Separate_Suffix;
+ end if;
+ end if;
+
+ Lang_Id :=
+ In_Tree.Languages_Data.Table (Lang_Id).Next;
+ end loop;
+ end if;
+ end;
+
+ -- Next, get the spec and body suffixes
+
+ declare
+ Suffix : Variable_Value;
+
+ Lang_Id : Language_Index := Data.First_Language_Processing;
+ Lang : Name_Id;
+ begin
+ while Lang_Id /= No_Language_Index loop
+ Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
+
+ -- Spec_Suffix
+
+ Suffix := Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Spec_Suffix,
+ In_Package => Naming_Id,
+ In_Tree => In_Tree);
+
+ if Suffix = Nil_Variable_Value then
+ Suffix := Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Specification_Suffix,
+ In_Package => Naming_Id,
+ In_Tree => In_Tree);
+ end if;
+
+ if Suffix /= Nil_Variable_Value then
+ In_Tree.Languages_Data.Table (Lang_Id).
+ Config.Naming_Data.Spec_Suffix :=
+ File_Name_Type (Suffix.Value);
+ end if;
+
+ -- Body_Suffix
+
+ Suffix := Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Body_Suffix,
+ In_Package => Naming_Id,
+ In_Tree => In_Tree);
+
+ if Suffix = Nil_Variable_Value then
+ Suffix := Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Implementation_Suffix,
+ In_Package => Naming_Id,
+ In_Tree => In_Tree);
+ end if;
+
+ if Suffix /= Nil_Variable_Value then
+ In_Tree.Languages_Data.Table (Lang_Id).
+ Config.Naming_Data.Body_Suffix :=
+ File_Name_Type (Suffix.Value);
+ end if;
+
+ Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
+ end loop;
+ end;
+
+ -- Get the exceptions for file based languages
+
+ Get_Exceptions (Spec);
+ Get_Exceptions (Impl);
+
+ -- Get the exceptions for unit based languages
+
+ Get_Unit_Exceptions (Spec);
+ Get_Unit_Exceptions (Impl);
+
+ end if;
end if;
- end Check_Naming_Scheme;
+ end Check_Naming_Schemes;
------------------------------
-- Check_Library_Attributes --
Prj.Util.Value_Of
(Snames.Name_Library_Kind, Attributes, In_Tree);
+ Imported_Project_List : Project_List := Empty_Project_List;
+
+ Continuation : String_Access := No_Continuation_String'Access;
+
+ Support_For_Libraries : Library_Support;
+
+ procedure Check_Library (Proj : Project_Id; Extends : Boolean);
+ -- Check if an imported or extended project if also a library project
+
+ -------------------
+ -- Check_Library --
+ -------------------
+
+ procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
+ Proj_Data : Project_Data;
+
+ begin
+ if Proj /= No_Project then
+ Proj_Data := In_Tree.Projects.Table (Proj);
+
+ if not Proj_Data.Library then
+ -- The only not library projects that are OK are those that
+ -- have no sources.
+
+ if Proj_Data.Source_Dirs /= Nil_String then
+
+ Error_Msg_Name_1 := Data.Name;
+ Error_Msg_Name_2 := Proj_Data.Name;
+
+ if Extends then
+ Error_Msg
+ (Project, In_Tree,
+ Continuation.all &
+ "library project %% cannot extend project %% " &
+ "that is not a library project",
+ Data.Location);
+
+ else
+ Error_Msg
+ (Project, In_Tree,
+ Continuation.all &
+ "library project %% cannot import project %% " &
+ "that is not a library project",
+ Data.Location);
+ end if;
+
+ Continuation := Continuation_String'Access;
+ end if;
+
+ elsif Data.Library_Kind /= Static and then
+ Proj_Data.Library_Kind = Static
+ then
+ Error_Msg_Name_1 := Data.Name;
+ Error_Msg_Name_2 := Proj_Data.Name;
+
+ if Extends then
+ Error_Msg
+ (Project, In_Tree,
+ Continuation.all &
+ "shared library project %% cannot extend static " &
+ "library project %%",
+ Data.Location);
+
+ else
+ Error_Msg
+ (Project, In_Tree,
+ Continuation.all &
+ "shared library project %% cannot import static " &
+ "library project %%",
+ Data.Location);
+ end if;
+
+ Continuation := Continuation_String'Access;
+ end if;
+ end if;
+ end Check_Library;
+
begin
-- Special case of extending project
begin
-- If the project extended is a library project, we inherit
-- the library name, if it is not redefined; we check that
- -- the library directory is specified; and we reset the
- -- library flag for the extended project.
+ -- the library directory is specified.
if Extended_Data.Library then
if Lib_Name.Default then
Data.Location);
end if;
end if;
-
- In_Tree.Projects.Table (Data.Extends).Library :=
- False;
end if;
end;
end if;
Data.Display_Directory,
Data.Library_Dir,
Data.Display_Library_Dir,
- Create => "library",
+ Create => "library",
Location => Lib_Dir.Location);
if Data.Library_Dir = No_Path then
begin
if Is_Absolute_Path (Dir_Name) then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Lib_Dir.Value);
+ Err_Vars.Error_Msg_File_1 := File_Name_Type (Lib_Dir.Value);
else
Get_Name_String (Data.Display_Directory);
Name_Buffer (Name_Len) := Directory_Separator;
end if;
- Name_Buffer (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
+ Name_Buffer
+ (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
Dir_Name;
Name_Len := Name_Len + Dir_Name'Length;
Err_Vars.Error_Msg_File_1 := Name_Find;
Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
- if Data.Library_Dir =
- Path_Name_Type (Dir_Elem.Value)
- then
+ if Data.Library_Dir = Path_Name_Type (Dir_Elem.Value) then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value);
Error_Msg
if Lib_Name.Value = Empty_String then
if Current_Verbosity = High
- and then Data.Library_Name = No_File
+ and then Data.Library_Name = No_Name
then
Write_Line ("No library name");
end if;
else
-- There is no restriction on the syntax of library names
- Data.Library_Name := File_Name_Type (Lib_Name.Value);
+ Data.Library_Name := Lib_Name.Value;
end if;
- if Data.Library_Name /= No_File
+ if Data.Library_Name /= No_Name
and then Current_Verbosity = High
then
Write_Str ("Library name = """);
Data.Library :=
Data.Library_Dir /= No_Path
- and then Data.Library_Name /= No_File;
+ and then
+ Data.Library_Name /= No_Name;
if Data.Library then
- if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then
+ if Get_Mode = Multi_Language then
+ Support_For_Libraries := In_Tree.Config.Lib_Support;
+
+ else
+ Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
+ end if;
+
+ if Support_For_Libraries = Prj.None then
Error_Msg
(Project, In_Tree,
"?libraries are not supported on this platform",
In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
- if
- Data.Library_ALI_Dir =
+ if Data.Library_ALI_Dir =
Path_Name_Type (Dir_Elem.Value)
then
Err_Vars.Error_Msg_File_1 :=
end if;
else
- Data.Lib_Internal_Name := File_Name_Type (Lib_Version.Value);
+ Data.Lib_Internal_Name := Lib_Version.Value;
end if;
pragma Assert (The_Lib_Kind.Kind = Single);
end if;
if Data.Library_Kind /= Static and then
- MLib.Tgt.Support_For_Libraries = MLib.Tgt.Static_Only
+ Support_For_Libraries = Prj.Static_Only
then
Error_Msg
(Project, In_Tree,
end;
end if;
- if Data.Library and then Current_Verbosity = High then
- Write_Line ("This is a library project file");
+ if Data.Library then
+ if Current_Verbosity = High then
+ Write_Line ("This is a library project file");
+ end if;
+
+ if Get_Mode = Multi_Language then
+ Check_Library (Data.Extends, Extends => True);
+
+ Imported_Project_List := Data.Imported_Projects;
+ while Imported_Project_List /= Empty_Project_List loop
+ Check_Library
+ (In_Tree.Project_Lists.Table
+ (Imported_Project_List).Project,
+ Extends => False);
+ Imported_Project_List :=
+ In_Tree.Project_Lists.Table
+ (Imported_Project_List).Next;
+ end loop;
+ end if;
end if;
end if;
end if;
+
+ if Data.Extends /= No_Project then
+ In_Tree.Projects.Table (Data.Extends).Library := False;
+ end if;
end Check_Library_Attributes;
--------------------------
-- If some suffixes have been specified, we make sure that
-- for each language for which a default suffix has been
-- specified, there is a suffix specified, either the one
- -- in the project file or if there were noe, the default.
+ -- in the project file or if there were none, the default.
if Impl_Suffixs /= No_Array_Element then
Suffix := Data.Naming.Body_Suffix;
---------------------------------
procedure Check_Programming_Languages
- (In_Tree : Project_Tree_Ref;
- Data : in out Project_Data)
+ (In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ Data : in out Project_Data)
is
Languages : Variable_Value := Nil_Variable_Value;
+ Lang : Language_Index;
begin
Languages :=
if Data.Source_Dirs /= Nil_String then
- -- Check if languages are specified in this project
+ -- Check if languages are specified in this project
+
+ if Languages.Default then
+
+ -- Attribute Languages is not specified. So, it defaults to
+ -- a project of the default language only.
+
+ Name_List_Table.Increment_Last (In_Tree.Name_Lists);
+ Data.Languages := Name_List_Table.Last (In_Tree.Name_Lists);
+
+ -- In Ada_Only mode, the default language is Ada
+
+ if Get_Mode = Ada_Only then
+ In_Tree.Name_Lists.Table (Data.Languages) :=
+ (Name => Name_Ada, Next => No_Name_List);
+
+ -- Attribute Languages is not specified. So, it defaults to
+ -- a project of language Ada only.
+
+ Data.Langs (Ada_Language_Index) := True;
+
+ -- No sources of languages other than Ada
+
+ Data.Other_Sources_Present := False;
+
+ elsif In_Tree.Default_Language = No_Name then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "no languages defined for this project",
+ Data.Location);
+
+ else
+ In_Tree.Name_Lists.Table (Data.Languages) :=
+ (Name => In_Tree.Default_Language, Next => No_Name_List);
+ Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
+ Data.First_Language_Processing :=
+ Language_Data_Table.Last (In_Tree.Languages_Data);
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing) := No_Language_Data;
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Name :=
+ In_Tree.Default_Language;
+ Get_Name_String (In_Tree.Default_Language);
+ Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Display_Name := Name_Find;
+
+ Lang := In_Tree.First_Language;
+
+ while Lang /= No_Language_Index loop
+ if In_Tree.Languages_Data.Table (Lang).Name =
+ In_Tree.Default_Language
+ then
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Config :=
+ In_Tree.Languages_Data.Table (Lang).Config;
+
+ if In_Tree.Languages_Data.Table (Lang).Config.Kind =
+ Unit_Based
+ then
+ Data.Unit_Based_Language_Name :=
+ In_Tree.Default_Language;
+ Data.Unit_Based_Language_Index :=
+ Data.First_Language_Processing;
+ end if;
+
+ exit;
+ end if;
+
+ Lang := In_Tree.Languages_Data.Table (Lang).Next;
+ end loop;
+ end if;
+
+ else
+ declare
+ Current : String_List_Id := Languages.Values;
+ Element : String_Element;
+ Lang_Name : Name_Id;
+ Display_Lang_Name : Name_Id;
+ Index : Language_Index;
+ Lang_Data : Language_Data;
+ NL_Id : Name_List_Index := No_Name_List;
+ Config : Language_Config;
+
+ begin
+ if Get_Mode = Ada_Only then
+ -- Assume that there is no language specified yet
+
+ Data.Other_Sources_Present := False;
+ Data.Ada_Sources_Present := False;
+ end if;
+
+ -- If there are no languages declared, there are no sources
+
+ if Current = Nil_String then
+ Data.Source_Dirs := Nil_String;
+
+ else
+ -- Look through all the languages specified in attribute
+ -- Languages.
+
+ while Current /= Nil_String loop
+ Element :=
+ In_Tree.String_Elements.Table (Current);
+ Display_Lang_Name := Element.Value;
+ Get_Name_String (Element.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Lang_Name := Name_Find;
+
+ Name_List_Table.Increment_Last (In_Tree.Name_Lists);
- if Languages.Default then
+ if NL_Id = No_Name_List then
+ Data.Languages :=
+ Name_List_Table.Last (In_Tree.Name_Lists);
- -- Attribute Languages is not specified. So, it defaults to
- -- a project of language Ada only.
+ else
+ In_Tree.Name_Lists.Table (NL_Id).Next :=
+ Name_List_Table.Last (In_Tree.Name_Lists);
+ end if;
- Data.Languages (Ada_Language_Index) := True;
+ NL_Id := Name_List_Table.Last (In_Tree.Name_Lists);
+ In_Tree.Name_Lists.Table (NL_Id) :=
+ (Lang_Name, No_Name_List);
- -- No sources of languages other than Ada
+ if Get_Mode = Ada_Only then
+ Index := Language_Indexes.Get (Lang_Name);
- Data.Other_Sources_Present := False;
+ if Index = No_Language_Index then
+ Add_Language_Name (Lang_Name);
+ Index := Last_Language_Index;
+ end if;
- else
- declare
- Current : String_List_Id := Languages.Values;
- Element : String_Element;
- Lang_Name : Name_Id;
- Index : Language_Index;
+ Set (Index, True, Data, In_Tree);
+ Set (Language_Processing =>
+ Default_Language_Processing_Data,
+ For_Language => Index,
+ In_Project => Data,
+ In_Tree => In_Tree);
- begin
- -- Assume that there is no language specified yet
+ if Index = Ada_Language_Index then
+ Data.Ada_Sources_Present := True;
- Data.Other_Sources_Present := False;
- Data.Ada_Sources_Present := False;
+ else
+ Data.Other_Sources_Present := True;
+ end if;
- -- Look through all the languages specified in attribute
- -- Languages, if any
+ else
+ Index := Data.First_Language_Processing;
- while Current /= Nil_String loop
- Element :=
- In_Tree.String_Elements.Table (Current);
- Get_Name_String (Element.Value);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Lang_Name := Name_Find;
- Index := Language_Indexes.Get (Lang_Name);
-
- if Index = No_Language_Index then
- Add_Language_Name (Lang_Name);
- Index := Last_Language_Index;
- end if;
+ while Index /= No_Language_Index loop
+ exit when
+ Lang_Name =
+ In_Tree.Languages_Data.Table (Index).Name;
+ Index := In_Tree.Languages_Data.Table (Index).Next;
+ end loop;
- Set (Index, True, Data, In_Tree);
- Set (Language_Processing => Default_Language_Processing_Data,
- For_Language => Index,
- In_Project => Data,
- In_Tree => In_Tree);
+ if Index = No_Language_Index then
+ Language_Data_Table.Increment_Last
+ (In_Tree.Languages_Data);
+ Index :=
+ Language_Data_Table.Last (In_Tree.Languages_Data);
+ Lang_Data.Name := Lang_Name;
+ Lang_Data.Display_Name := Element.Value;
+ Lang_Data.Next := Data.First_Language_Processing;
+ In_Tree.Languages_Data.Table (Index) := Lang_Data;
+ Data.First_Language_Processing := Index;
+
+ Index := In_Tree.First_Language;
+
+ while Index /= No_Language_Index loop
+ exit when
+ Lang_Name =
+ In_Tree.Languages_Data.Table (Index).Name;
+ Index :=
+ In_Tree.Languages_Data.Table (Index).Next;
+ end loop;
+
+ if Index = No_Language_Index then
+ Error_Msg
+ (Project, In_Tree,
+ "language """ &
+ Get_Name_String (Display_Lang_Name) &
+ """ not found in configuration",
+ Languages.Location);
- if Index = Ada_Language_Index then
- Data.Ada_Sources_Present := True;
+ else
+ Config :=
+ In_Tree.Languages_Data.Table (Index).Config;
+
+ -- Duplicate name lists
+
+ Duplicate
+ (Config.Compiler_Min_Options, In_Tree);
+ Duplicate
+ (Config.Compilation_PIC_Option, In_Tree);
+ Duplicate
+ (Config.Mapping_File_Switches, In_Tree);
+ Duplicate
+ (Config.Config_File_Switches, In_Tree);
+ Duplicate
+ (Config.Dependency_Option, In_Tree);
+ Duplicate
+ (Config.Compute_Dependency, In_Tree);
+ Duplicate
+ (Config.Include_Option, In_Tree);
+ Duplicate
+ (Config.Binder_Min_Options, In_Tree);
+
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Config :=
+ Config;
+
+ if Config.Kind = Unit_Based then
+ if
+ Data.Unit_Based_Language_Name = No_Name
+ then
+ Data.Unit_Based_Language_Name := Lang_Name;
+ Data.Unit_Based_Language_Index :=
+ Language_Data_Table.Last
+ (In_Tree.Languages_Data);
- else
- Data.Other_Sources_Present := True;
- end if;
+ else
+ Error_Msg
+ (Project, In_Tree,
+ "not allowed to have several " &
+ "unit-based languages in the same " &
+ "project",
+ Languages.Location);
+ end if;
+ end if;
+ end if;
+ end if;
+ end if;
- Current := Element.Next;
- end loop;
+ Current := Element.Next;
+ end loop;
+ end if;
end;
end if;
end if;
Data.Decl.Attributes,
In_Tree);
- Auto_Init_Supported : constant Boolean :=
- MLib.Tgt.
- Standalone_Library_Auto_Init_Is_Supported;
+ Auto_Init_Supported : Boolean;
+
+ OK : Boolean := True;
- OK : Boolean := True;
+ Source : Source_Id;
+ Next_Proj : Project_Id;
begin
+ if Get_Mode = Multi_Language then
+ Auto_Init_Supported := In_Tree.Config.Auto_Init_Supported;
+
+ else
+ Auto_Init_Supported :=
+ MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
+ end if;
+
pragma Assert (Lib_Interfaces.Kind = List);
-- It is a stand-alone library project file if attribute
Interfaces : String_List_Id := Lib_Interfaces.Values;
Interface_ALIs : String_List_Id := Nil_String;
Unit : Name_Id;
- The_Unit_Id : Unit_Id;
+ The_Unit_Id : Unit_Index;
The_Unit_Data : Unit_Data;
procedure Add_ALI_For (Source : File_Name_Type);
Get_Name_String (Source);
declare
- ALI : constant String :=
- ALI_File_Name (Name_Buffer (1 .. Name_Len));
-
- ALI_Name_Id : File_Name_Type;
-
+ ALI : constant String :=
+ ALI_File_Name (Name_Buffer (1 .. Name_Len));
+ ALI_Name_Id : Name_Id;
begin
Name_Len := ALI'Length;
Name_Buffer (1 .. Name_Len) := ALI;
String_Element_Table.Increment_Last
(In_Tree.String_Elements);
-
In_Tree.String_Elements.Table
(String_Element_Table.Last
(In_Tree.String_Elements)) :=
- (Value => Name_Id (ALI_Name_Id),
+ (Value => ALI_Name_Id,
Index => 0,
- Display_Value => Name_Id (ALI_Name_Id),
+ Display_Value => ALI_Name_Id,
Location =>
In_Tree.String_Elements.Table
(Interfaces).Location,
Flag => False,
Next => Interface_ALIs);
-
Interface_ALIs := String_Element_Table.Last
(In_Tree.String_Elements);
end;
while Interfaces /= Nil_String loop
Get_Name_String
- (In_Tree.String_Elements.Table
- (Interfaces).Value);
+ (In_Tree.String_Elements.Table (Interfaces).Value);
To_Lower (Name_Buffer (1 .. Name_Len));
if Name_Len = 0 then
Error_Msg
(Project, In_Tree,
"an interface cannot be an empty string",
- In_Tree.String_Elements.Table
- (Interfaces).Location);
+ In_Tree.String_Elements.Table (Interfaces).Location);
else
Unit := Name_Find;
Error_Msg_Name_1 := Unit;
- The_Unit_Id :=
- Units_Htable.Get (In_Tree.Units_HT, Unit);
- if The_Unit_Id = No_Unit then
- Error_Msg
- (Project, In_Tree,
- "unknown unit %%",
- In_Tree.String_Elements.Table
- (Interfaces).Location);
+ if Get_Mode = Ada_Only then
+ The_Unit_Id :=
+ Units_Htable.Get (In_Tree.Units_HT, Unit);
- else
- -- Check that the unit is part of the project
+ if The_Unit_Id = No_Unit_Index then
+ Error_Msg
+ (Project, In_Tree,
+ "unknown unit %%",
+ In_Tree.String_Elements.Table
+ (Interfaces).Location);
- The_Unit_Data :=
- In_Tree.Units.Table (The_Unit_Id);
+ else
+ -- Check that the unit is part of the project
- if The_Unit_Data.File_Names (Body_Part).Name /= No_File
- and then The_Unit_Data.File_Names (Body_Part).Path /=
- Slash
- then
- if Check_Project
- (The_Unit_Data.File_Names (Body_Part).Project,
- Project, In_Tree, Extending)
- then
- -- There is a body for this unit.
- -- If there is no spec, we need to check
- -- that it is not a subunit.
+ The_Unit_Data :=
+ In_Tree.Units.Table (The_Unit_Id);
- if The_Unit_Data.File_Names (Specification).Name =
- No_File
+ if The_Unit_Data.File_Names (Body_Part).Name /= No_File
+ and then The_Unit_Data.File_Names (Body_Part).Path /=
+ Slash
+ then
+ if Check_Project
+ (The_Unit_Data.File_Names (Body_Part).Project,
+ Project, In_Tree, Extending)
then
- declare
- Src_Ind : Source_File_Index;
+ -- There is a body for this unit.
+ -- If there is no spec, we need to check
+ -- that it is not a subunit.
- begin
- Src_Ind :=
- Sinput.P.Load_Project_File
- (Get_Name_String
- (The_Unit_Data.File_Names
- (Body_Part).Path));
-
- if Sinput.P.Source_File_Is_Subunit
- (Src_Ind)
- then
- Error_Msg
- (Project, In_Tree,
- "%% is a subunit; " &
- "it cannot be an interface",
- In_Tree.
- String_Elements.Table
- (Interfaces).Location);
- end if;
- end;
+ if The_Unit_Data.File_Names
+ (Specification).Name = No_File
+ then
+ declare
+ Src_Ind : Source_File_Index;
+
+ begin
+ Src_Ind := Sinput.P.Load_Project_File
+ (Get_Name_String
+ (The_Unit_Data.File_Names
+ (Body_Part).Path));
+
+ if Sinput.P.Source_File_Is_Subunit
+ (Src_Ind)
+ then
+ Error_Msg
+ (Project, In_Tree,
+ "%% is a subunit; " &
+ "it cannot be an interface",
+ In_Tree.
+ String_Elements.Table
+ (Interfaces).Location);
+ end if;
+ end;
+ end if;
+
+ -- The unit is not a subunit, so we add
+ -- to the Interface ALIs the ALI file
+ -- corresponding to the body.
+
+ Add_ALI_For
+ (The_Unit_Data.File_Names (Body_Part).Name);
+
+ else
+ Error_Msg
+ (Project, In_Tree,
+ "%% is not an unit of this project",
+ In_Tree.String_Elements.Table
+ (Interfaces).Location);
end if;
- -- The unit is not a subunit, so we add
- -- to the Interface ALIs the ALI file
- -- corresponding to the body.
+ elsif The_Unit_Data.File_Names
+ (Specification).Name /= No_File
+ and then The_Unit_Data.File_Names
+ (Specification).Path /= Slash
+ and then Check_Project
+ (The_Unit_Data.File_Names
+ (Specification).Project,
+ Project, In_Tree, Extending)
+
+ then
+ -- The unit is part of the project, it has
+ -- a spec, but no body. We add to the Interface
+ -- ALIs the ALI file corresponding to the spec.
Add_ALI_For
- (The_Unit_Data.File_Names (Body_Part).Name);
+ (The_Unit_Data.File_Names (Specification).Name);
else
Error_Msg
In_Tree.String_Elements.Table
(Interfaces).Location);
end if;
+ end if;
- elsif The_Unit_Data.File_Names (Specification).Name /=
- No_File
- and then
- The_Unit_Data.File_Names (Specification).Path /= Slash
- and then
- Check_Project
- (The_Unit_Data.File_Names (Specification).Project,
- Project, In_Tree, Extending)
+ else
+ -- Multi_Language mode
- then
- -- The unit is part of the project, it has
- -- a spec, but no body. We add to the Interface
- -- ALIs the ALI file corresponding to the spec.
+ Next_Proj := Data.Extends;
+ Source := Data.First_Source;
+
+ loop
+ while Source /= No_Source and then
+ In_Tree.Sources.Table (Source).Unit /= Unit
+ loop
+ Source :=
+ In_Tree.Sources.Table (Source).Next_In_Project;
+ end loop;
+
+ exit when Source /= No_Source or else
+ Next_Proj = No_Project;
+
+ Source :=
+ In_Tree.Projects.Table (Next_Proj).First_Source;
+ Next_Proj :=
+ In_Tree.Projects.Table (Next_Proj).Extends;
+ end loop;
+
+ if Source /= No_Source then
+ if In_Tree.Sources.Table (Source).Kind = Sep then
+ Source := No_Source;
+
+ elsif In_Tree.Sources.Table (Source).Kind = Spec
+ and then
+ In_Tree.Sources.Table (Source).Other_Part /=
+ No_Source
+ then
+ Source := In_Tree.Sources.Table (Source).Other_Part;
+ end if;
+ end if;
- Add_ALI_For
- (The_Unit_Data.File_Names (Specification).Name);
+ if Source /= No_Source then
+ if In_Tree.Sources.Table (Source).Project /= Project
+ and then
+ not Is_Extending
+ (Project,
+ In_Tree.Sources.Table (Source).Project,
+ In_Tree)
+ then
+ Source := No_Source;
+ end if;
+ end if;
+
+ if Source = No_Source then
+ Error_Msg
+ (Project, In_Tree,
+ "%% is not an unit of this project",
+ In_Tree.String_Elements.Table
+ (Interfaces).Location);
else
- Error_Msg
- (Project, In_Tree,
- "%% is not an unit of this project",
- In_Tree.String_Elements.Table
- (Interfaces).Location);
+ if In_Tree.Sources.Table (Source).Kind = Spec and then
+ In_Tree.Sources.Table (Source).Other_Part /=
+ No_Source
+ then
+ Source :=
+ In_Tree.Sources.Table (Source).Other_Part;
+ end if;
+
+ String_Element_Table.Increment_Last
+ (In_Tree.String_Elements);
+ In_Tree.String_Elements.Table
+ (String_Element_Table.Last
+ (In_Tree.String_Elements)) :=
+ (Value =>
+ Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
+ Index => 0,
+ Display_Value =>
+ Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
+ Location =>
+ In_Tree.String_Elements.Table
+ (Interfaces).Location,
+ Flag => False,
+ Next => Interface_ALIs);
+ Interface_ALIs := String_Element_Table.Last
+ (In_Tree.String_Elements);
end if;
+
end if;
end if;
Data.Display_Directory,
Data.Library_Src_Dir,
Data.Display_Library_Src_Dir,
- Create => "library source copy",
+ Create => "library source copy",
Location => Lib_Src_Dir.Location);
-- If directory does not exist, report an error
Name_Len + Dir_Name'Length) :=
Dir_Name;
Name_Len := Name_Len + Dir_Name'Length;
- Err_Vars.Error_Msg_File_1 := Name_Find;
+ Err_Vars.Error_Msg_Name_1 := Name_Find;
end if;
-- Report the error
-- Report error if it is one of the source directories
if Data.Library_Src_Dir =
- Path_Name_Type (Src_Dir.Value)
+ Path_Name_Type (Src_Dir.Value)
then
Error_Msg
(Project, In_Tree,
-- directories
if Data.Library_Src_Dir =
- Path_Name_Type (Src_Dir.Value)
+ Path_Name_Type (Src_Dir.Value)
then
Error_Msg_File_1 :=
File_Name_Type (Src_Dir.Value);
elsif Value = "restricted" then
Data.Symbol_Data.Symbol_Policy := Restricted;
- elsif Value = "direct" then
- Data.Symbol_Data.Symbol_Policy := Direct;
-
else
Error_Msg
(Project, In_Tree,
end if;
-- If attribute Library_Symbol_File is not specified, symbol policy
- -- cannot be Restricted or Direct.
+ -- cannot be Restricted.
if Lib_Symbol_File.Default then
if Data.Symbol_Data.Symbol_Policy = Restricted then
Lib_Symbol_Policy.Location);
end if;
- Name_Len := 0;
- Add_Str_To_Name_Buffer (Default_Symbol_File_Name);
- Data.Symbol_Data.Symbol_File := Name_Find;
- Get_Name_String (Data.Symbol_Data.Symbol_File);
-
else
- -- Library_Symbol_File is defined
+ -- Library_Symbol_File is defined. Check that the file exists
- Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value;
+ Data.Symbol_Data.Symbol_File :=
+ Path_Name_Type (Lib_Symbol_File.Value);
Get_Name_String (Lib_Symbol_File.Value);
(Project, In_Tree,
"symbol file name cannot be an empty string",
Lib_Symbol_File.Location);
- end if;
- end if;
- if Name_Len /= 0 then
- OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
+ else
+ OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
- if OK then
- for J in 1 .. Name_Len loop
- if Name_Buffer (J) = '/'
- or else Name_Buffer (J) = Directory_Separator
- then
- OK := False;
- exit;
- end if;
- end loop;
- end if;
+ if OK then
+ for J in 1 .. Name_Len loop
+ if Name_Buffer (J) = '/'
+ or else Name_Buffer (J) = Directory_Separator
+ then
+ OK := False;
+ exit;
+ end if;
+ end loop;
+ end if;
- if not OK then
- Error_Msg_File_1 :=
- File_Name_Type (Lib_Symbol_File.Value);
- Error_Msg
- (Project, In_Tree,
- "symbol file name { is illegal. " &
- "Name canot include directory info.",
- Lib_Symbol_File.Location);
+ if not OK then
+ Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
+ Error_Msg
+ (Project, In_Tree,
+ "symbol file name { is illegal. " &
+ "Name canot include directory info.",
+ Lib_Symbol_File.Location);
+ end if;
end if;
end if;
-- If attribute Library_Reference_Symbol_File is not defined,
- -- symbol policy cannot be Compilant, Controlled or Direct.
+ -- symbol policy cannot be Compilant or Controlled.
if Lib_Ref_Symbol_File.Default then
if Data.Symbol_Data.Symbol_Policy = Compliant
or else Data.Symbol_Data.Symbol_Policy = Controlled
- or else Data.Symbol_Data.Symbol_Policy = Direct
then
Error_Msg
(Project, In_Tree,
else
-- Library_Reference_Symbol_File is defined, check file exists
- Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value;
+ Data.Symbol_Data.Reference :=
+ Path_Name_Type (Lib_Ref_Symbol_File.Value);
Get_Name_String (Lib_Ref_Symbol_File.Value);
Lib_Symbol_File.Location);
else
- if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
- Name_Len := 0;
- Add_Str_To_Name_Buffer (Get_Name_String (Data.Directory));
- Add_Char_To_Name_Buffer (Directory_Separator);
- Add_Str_To_Name_Buffer
- (Get_Name_String (Lib_Ref_Symbol_File.Value));
- Data.Symbol_Data.Reference := Name_Find;
+ OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
+
+ if OK then
+ for J in 1 .. Name_Len loop
+ if Name_Buffer (J) = '/'
+ or else Name_Buffer (J) = Directory_Separator
+ then
+ OK := False;
+ exit;
+ end if;
+ end loop;
+ end if;
+
+ if not OK then
+ Error_Msg_File_1 :=
+ File_Name_Type (Lib_Ref_Symbol_File.Value);
+ Error_Msg
+ (Project, In_Tree,
+ "reference symbol file { name is illegal. " &
+ "Name canot include directory info.",
+ Lib_Ref_Symbol_File.Location);
end if;
if not Is_Regular_File
- (Get_Name_String (Data.Symbol_Data.Reference))
+ (Get_Name_String (Data.Object_Directory) &
+ Directory_Separator &
+ Get_Name_String (Lib_Ref_Symbol_File.Value))
then
Error_Msg_File_1 :=
File_Name_Type (Lib_Ref_Symbol_File.Value);
- -- For controlled and direct symbol policies, it is an error
- -- if the reference symbol file does not exist. For other
- -- symbol policies, this is just a warning
+ -- For controlled symbol policy, it is an error if the
+ -- reference symbol file does not exist. For other symbol
+ -- policies, this is just a warning
Error_Msg_Warn :=
- Data.Symbol_Data.Symbol_Policy /= Controlled
- and then Data.Symbol_Data.Symbol_Policy /= Direct;
+ Data.Symbol_Data.Symbol_Policy /= Controlled;
Error_Msg
(Project, In_Tree,
end if;
end if;
end if;
-
- -- If both the reference symbol file and the symbol file are
- -- defined, then check that they are not the same file.
-
- Get_Name_String (Data.Symbol_Data.Symbol_File);
-
- if Name_Len > 0 then
- declare
- Symb_Path : constant String :=
- Normalize_Pathname
- (Get_Name_String (Data.Object_Directory) &
- Directory_Separator &
- Name_Buffer (1 .. Name_Len));
- Ref_Path : constant String :=
- Normalize_Pathname
- (Get_Name_String
- (Data.Symbol_Data.Reference));
-
- begin
- if Symb_Path = Ref_Path then
- Error_Msg
- (Project, In_Tree,
- "library reference symbol file and library symbol" &
- " file cannot be the same file",
- Lib_Ref_Symbol_File.Location);
- end if;
- end;
- end if;
end if;
end if;
end if;
end if;
end Compute_Directory_Last;
- --------------------
- -- 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;
-
---------------
-- Error_Msg --
---------------
Index := Index + 1;
end if;
- Add_Name;
- else
- Add (Msg (Index));
+ Add_Name;
+ else
+ Add (Msg (Index));
+ end if;
+ Index := Index + 1;
+
+ end loop;
+
+ Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
+ end Error_Msg;
+
+ ----------------------
+ -- Find_Ada_Sources --
+ ----------------------
+
+ procedure Find_Ada_Sources
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Follow_Links : Boolean := False)
+ is
+ Source_Dir : String_List_Id := Data.Source_Dirs;
+ Element : String_Element;
+ Dir : Dir_Type;
+ Current_Source : String_List_Id := Nil_String;
+ Source_Recorded : Boolean := False;
+
+ begin
+ if Current_Verbosity = High then
+ Write_Line ("Looking for sources:");
+ end if;
+
+ -- For each subdirectory
+
+ while Source_Dir /= Nil_String loop
+ begin
+ Source_Recorded := False;
+ Element := In_Tree.String_Elements.Table (Source_Dir);
+ if Element.Value /= No_Name then
+ Get_Name_String (Element.Display_Value);
+
+ declare
+ Source_Directory : constant String :=
+ Name_Buffer (1 .. Name_Len) & Directory_Separator;
+ Dir_Last : constant Natural :=
+ Compute_Directory_Last (Source_Directory);
+
+ begin
+ if Current_Verbosity = High then
+ Write_Str ("Source_Dir = ");
+ Write_Line (Source_Directory);
+ end if;
+
+ -- We look to every entry in the source directory
+
+ Open (Dir, Source_Directory
+ (Source_Directory'First .. Dir_Last));
+
+ loop
+ Read (Dir, Name_Buffer, Name_Len);
+
+ if Current_Verbosity = High then
+ Write_Str (" Checking ");
+ Write_Line (Name_Buffer (1 .. Name_Len));
+ end if;
+
+ exit when Name_Len = 0;
+
+ declare
+ File_Name : constant File_Name_Type := Name_Find;
+ Path : constant String :=
+ Normalize_Pathname
+ (Name => Name_Buffer (1 .. Name_Len),
+ Directory => Source_Directory
+ (Source_Directory'First .. Dir_Last),
+ Resolve_Links => Follow_Links,
+ Case_Sensitive => True);
+ Path_Name : Path_Name_Type;
+
+ begin
+ Name_Len := Path'Length;
+ Name_Buffer (1 .. Name_Len) := Path;
+ Path_Name := Name_Find;
+
+ -- We attempt to register it as a source. However,
+ -- there is no error if the file does not contain
+ -- a valid source. But there is an error if we have
+ -- a duplicate unit name.
+
+ Record_Ada_Source
+ (File_Name => File_Name,
+ Path_Name => Path_Name,
+ Project => Project,
+ In_Tree => In_Tree,
+ Data => Data,
+ Location => No_Location,
+ Current_Source => Current_Source,
+ Source_Recorded => Source_Recorded,
+ Follow_Links => Follow_Links);
+ end;
+ end loop;
+
+ Close (Dir);
+ end;
+ end if;
+
+ exception
+ when Directory_Error =>
+ null;
+ end;
+
+ if Source_Recorded then
+ In_Tree.String_Elements.Table (Source_Dir).Flag :=
+ True;
end if;
- Index := Index + 1;
+ Source_Dir := Element.Next;
end loop;
- Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
- end Error_Msg;
+ if Current_Verbosity = High then
+ Write_Line ("end Looking for sources.");
+ end if;
+
+ -- If we have looked for sources and found none, then
+ -- it is an error, except if it is an extending project.
+ -- If a non extending project is not supposed to contain
+ -- any source, then we never call Find_Ada_Sources.
+
+ if Current_Source = Nil_String and then
+ Data.Extends = No_Project
+ then
+ Report_No_Sources (Project, "Ada", In_Tree, Data.Location);
+ end if;
+ end Find_Ada_Sources;
------------------
-- Find_Sources --
(Source_Directory'First .. Dir_Last),
Resolve_Links => Follow_Links,
Case_Sensitive => True);
- Path_Name : File_Name_Type;
+ Path_Name : Path_Name_Type;
begin
Name_Len := Path'Length;
Data.Ada_Sources_Present := True;
elsif Data.Extends = No_Project then
- Report_No_Ada_Sources (Project, In_Tree, Data.Location);
+ Report_No_Sources (Project, "Ada", In_Tree, Data.Location);
end if;
end if;
end Find_Sources;
Util.Value_Of
(Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
+ Source_Files : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_Files, Data.Decl.Attributes, In_Tree);
+
Last_Source_Dir : String_List_Id := Nil_String;
procedure Find_Source_Dirs
(From : File_Name_Type;
Location : Source_Ptr);
- -- Find one or several source directories, and add them to the list of
- -- source directories of the project.
- -- What is Location??? and what is From???
+ -- Find one or several source directories, and add them
+ -- to the list of source directories of the project.
----------------------
-- Find_Source_Dirs --
Element : String_Element;
Found : Boolean := False;
- Non_Canonical_Path : File_Name_Type := No_File;
- Canonical_Path : File_Name_Type := No_File;
+ Non_Canonical_Path : Name_Id := No_Name;
+ Canonical_Path : Name_Id := No_Name;
The_Path : constant String :=
Normalize_Pathname (Get_Name_String (Path)) &
Element := In_Tree.String_Elements.Table (List);
if Element.Value /= No_Name then
- Found := Element.Value = Name_Id (Canonical_Path);
+ Found := Element.Value = Canonical_Path;
exit when Found;
end if;
String_Element_Table.Increment_Last
(In_Tree.String_Elements);
Element :=
- (Value => Name_Id (Canonical_Path),
- Display_Value => Name_Id (Non_Canonical_Path),
- Location => No_Location,
- Flag => False,
- Next => Nil_String,
- Index => 0);
+ (Value => Canonical_Path,
+ Display_Value => Non_Canonical_Path,
+ Location => No_Location,
+ Flag => False,
+ Next => Nil_String,
+ Index => 0);
-- Case of first source directory
In_Tree.String_Elements.Table
(Last_Source_Dir).Next :=
- String_Element_Table.Last (In_Tree.String_Elements);
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
end if;
-- And register this source directory as the new last
Last_Source_Dir := String_Element_Table.Last
(In_Tree.String_Elements);
- In_Tree.String_Elements.Table (Last_Source_Dir) := Element;
+ In_Tree.String_Elements.Table (Last_Source_Dir) :=
+ Element;
end if;
-- Now look for subdirectories. We do that even when this
Base_Dir : constant File_Name_Type := Name_Find;
Root_Dir : constant String :=
Normalize_Pathname
- (Name => Get_Name_String (Base_Dir),
- Directory =>
+ (Name => Get_Name_String (Base_Dir),
+ Directory =>
Get_Name_String (Data.Display_Directory),
Resolve_Links => False,
Case_Sensitive => True);
end if;
else
- -- As it is an existing directory, we add it to the list of
- -- directories.
+ -- As it is an existing directory, we add it to
+ -- the list of directories.
String_Element_Table.Increment_Last
(In_Tree.String_Elements);
In_Tree.String_Elements.Table
(Last_Source_Dir).Next :=
- String_Element_Table.Last (In_Tree.String_Elements);
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
end if;
-- And register this source directory as the new last
Last_Source_Dir := String_Element_Table.Last
(In_Tree.String_Elements);
- In_Tree.String_Elements.Table (Last_Source_Dir) := Element;
+ In_Tree.String_Elements.Table
+ (Last_Source_Dir) := Element;
end if;
end;
end if;
if Data.Object_Directory = No_Path then
- -- The object directory does not exist, report an error
+ -- The object directory does not exist, report an error if the
+ -- project is not externally built.
- Err_Vars.Error_Msg_File_1 := File_Name_Type (Object_Dir.Value);
- Error_Msg
- (Project, In_Tree,
- "the object directory { cannot be found",
- Data.Location);
+ if not Data.Externally_Built then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Object_Dir.Value);
+ Error_Msg
+ (Project, In_Tree,
+ "the object directory { cannot be found",
+ Data.Location);
+ end if;
-- Do not keep a nil Object_Directory. Set it to the specified
-- (relative or absolute) path. This is for the benefit of
Exec_Dir.Location);
else
- -- We check that the specified object directory does exist
+ -- We check that the specified object directory
+ -- does exist.
Locate_Directory
(Project,
Location => Exec_Dir.Location);
if Data.Exec_Directory = No_Path then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Exec_Dir.Value);
+ Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
Error_Msg
(Project, In_Tree,
"the exec directory { cannot be found",
pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
- if Source_Dirs.Default then
+ if (not Source_Files.Default) and then
+ Source_Files.Values = Nil_String
+ then
+ Data.Source_Dirs := Nil_String;
+
+ if Data.Extends = No_Project
+ and then Data.Object_Directory = Data.Directory
+ then
+ Data.Object_Directory := No_Path;
+ end if;
+
+ elsif Source_Dirs.Default then
-- No Source_Dirs specified: the single source directory
-- is the one containing the project file
end if;
Data.Source_Dirs := Nil_String;
- Data.Ada_Sources_Present := False;
- Data.Other_Sources_Present := False;
else
declare
-- element of the list
while Source_Dir /= Nil_String loop
- Element := In_Tree.String_Elements.Table (Source_Dir);
+ Element :=
+ In_Tree.String_Elements.Table (Source_Dir);
Find_Source_Dirs
(File_Name_Type (Element.Value), Element.Location);
Source_Dir := Element.Next;
Current := Element.Next;
end loop;
end;
+
end Get_Directories;
---------------
if Mains.Default then
if Data.Extends /= No_Project then
- Data.Mains := In_Tree.Projects.Table (Data.Extends).Mains;
+ Data.Mains :=
+ In_Tree.Projects.Table (Data.Extends).Mains;
end if;
-- In a library project file, Main cannot be specified
Line : String (1 .. 250);
Last : Natural;
Source_Name : File_Name_Type;
+ Name_Loc : Name_Location;
begin
- Source_Names.Reset;
+ if Get_Mode = Ada_Only then
+ Source_Names.Reset;
+ end if;
if Current_Verbosity = High then
Write_Str ("Opening """);
Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Source_Name := Name_Find;
- Source_Names.Set
- (K => Source_Name,
- E =>
+ Name_Loc := Source_Names.Get (Source_Name);
+
+ if Name_Loc = No_Name_Location then
+ Name_Loc :=
(Name => Source_Name,
Location => Location,
- Found => False));
+ Source => No_Source,
+ Except => False,
+ Found => False);
+ end if;
+
+ Source_Names.Set (Source_Name, Name_Loc);
end if;
end loop;
--------------
procedure Get_Unit
- (Canonical_File_Name : File_Name_Type;
+ (In_Tree : Project_Tree_Ref;
+ Canonical_File_Name : File_Name_Type;
Naming : Naming_Data;
Exception_Id : out Ada_Naming_Exception_Id;
Unit_Name : out Name_Id;
begin
Standard_GNAT :=
- Naming.Ada_Spec_Suffix = Default_Ada_Spec_Suffix
- and then Naming.Ada_Body_Suffix = Default_Ada_Body_Suffix;
+ Spec_Suffix_Id_Of (In_Tree, "ada", Naming) = Default_Ada_Spec_Suffix
+ and then
+ Body_Suffix_Id_Of (In_Tree, "ada", Naming) = Default_Ada_Body_Suffix;
-- Check if the end of the file name is Specification_Append
- Get_Name_String (Naming.Ada_Spec_Suffix);
+ Get_Name_String (Spec_Suffix_Id_Of (In_Tree, "ada", Naming));
if File'Length > Name_Len
and then File (Last - Name_Len + 1 .. Last) =
end if;
else
- Get_Name_String (Naming.Ada_Body_Suffix);
+ Get_Name_String (Body_Suffix_Id_Of (In_Tree, "ada", Naming));
-- Check if the end of the file name is Body_Append
Write_Line (File (First .. Last));
end if;
- elsif Naming.Separate_Suffix /= Naming.Ada_Spec_Suffix then
+ elsif Naming.Separate_Suffix /=
+ Body_Suffix_Id_Of (In_Tree, "ada", Naming)
+ then
Get_Name_String (Naming.Separate_Suffix);
-- Check if the end of the file name is Separate_Append
Create : String := "";
Location : Source_Ptr := No_Location)
is
- The_Name : constant String := Get_Name_String (Name);
+ The_Name : String := Get_Name_String (Name);
- The_Parent : constant String :=
+ The_Parent : constant String :=
Get_Name_String (Parent) & Directory_Separator;
The_Parent_Last : constant Natural :=
Compute_Directory_Last (The_Parent);
- Full_Name : File_Name_Type;
+ Full_Name : File_Name_Type;
begin
+ -- Convert '/' to directory separator (for Windows)
+
+ for J in The_Name'Range loop
+ if The_Name (J) = '/' then
+ The_Name (J) := Directory_Separator;
+ end if;
+ end loop;
+
if Current_Verbosity = High then
Write_Str ("Locate_Directory (""");
Write_Str (The_Name);
-- Find the path names of the source files in the Source_Names table
-- in the source directories and record those that are Ada sources.
+-- function Source_Of (File_Name : Name_Id) return Source_Id;
+
procedure Get_Sources_From_File
(Path : String;
Location : Source_Ptr);
-- Get the sources of a project from a text file
+ procedure Search_Directories (For_All_Sources : Boolean);
+ -- Search the source directories to find the sources.
+ -- If For_All_Sources is True, check each regular file name against
+ -- the naming schemes of the different languages. Otherwise consider
+ -- only the file names in the hash table Source_Names.
+
---------------------------------------
-- Get_Path_Names_And_Record_Sources --
---------------------------------------
procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean) is
Source_Dir : String_List_Id := Data.Source_Dirs;
Element : String_Element;
- Path : File_Name_Type;
+ Path : Path_Name_Type;
Dir : Dir_Type;
Name : File_Name_Type;
end;
if Source_Recorded then
- In_Tree.String_Elements.Table (Source_Dir).Flag := True;
+ In_Tree.String_Elements.Table (Source_Dir).Flag :=
+ True;
end if;
Source_Dir := Element.Next;
Get_Sources_From_File (Path, Location, Project, In_Tree);
- -- Look in the source directories to find those sources
+ if Get_Mode = Ada_Only then
+ -- Look in the source directories to find those sources
+
+ Get_Path_Names_And_Record_Sources (Follow_Links);
- Get_Path_Names_And_Record_Sources (Follow_Links);
+ -- We should have found at least one source.
+ -- If not, report an error.
- -- We should have found at least one source.
- -- If not, report an error/warning.
+ if Data.Ada_Sources = Nil_String then
+ Report_No_Sources (Project, "Ada", In_Tree, Location);
+ end if;
- if Data.Sources = Nil_String then
- Report_No_Ada_Sources (Project, In_Tree, Location);
+ else
+ null;
end if;
end Get_Sources_From_File;
+ ------------------------
+ -- Search_Directories --
+ ------------------------
+
+ procedure Search_Directories (For_All_Sources : Boolean) is
+ Source_Dir : String_List_Id := Data.Source_Dirs;
+ Element : String_Element;
+ Dir : Dir_Type;
+ Name : String (1 .. 1_000);
+ Last : Natural;
+
+ File_Name : File_Name_Type;
+ Display_File_Name : File_Name_Type;
+
+ Source : Source_Id;
+ Source_To_Replace : Source_Id := No_Source;
+ Src_Data : Source_Data;
+ Add_Src : Boolean;
+
+ Name_Loc : Name_Location;
+
+ Check_Name : Boolean;
+
+ Language : Language_Index;
+ Language_Name : Name_Id;
+ Display_Language_Name : Name_Id;
+ Unit : Name_Id;
+ Kind : Source_Kind := Spec;
+ Alternate_Languages : Alternate_Language_Id :=
+ No_Alternate_Language;
+
+ OK : Boolean;
+
+ procedure Check_Naming_Schemes;
+ -- Check if the file name File_Name conforms to one of the naming
+ -- schemes of the project. If it does, set the global variables
+ -- Language, Language_Name, Display_Language_Name, Unit and Kind
+ -- appropriately. If it does not, set Language to No_Language_Index.
+
+ --------------------------
+ -- Check_Naming_Schemes --
+ --------------------------
+
+ procedure Check_Naming_Schemes is
+ Filename : constant String := Get_Name_String (File_Name);
+ Last : Positive := Filename'Last;
+
+ Config : Language_Config;
+
+ Lang : Name_List_Index := Data.Languages;
+
+ Header_File : Boolean := False;
+ First_Language : Language_Index;
+
+ begin
+ Unit := No_Name;
+
+ while Lang /= No_Name_List loop
+
+ Language := Data.First_Language_Processing;
+ Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
+
+ while Language /= No_Language_Index loop
+ if In_Tree.Languages_Data.Table (Language).Name =
+ Language_Name
+ then
+ Display_Language_Name :=
+ In_Tree.Languages_Data.Table (Language).Display_Name;
+ Config := In_Tree.Languages_Data.Table (Language).Config;
+
+ if Config.Kind = File_Based then
+ -- For file based languages, there is no Unit.
+ -- Just check if the file name has the implementation
+ -- or, if it is specified, the template suffix of the
+ -- language.
+
+ Unit := No_Name;
+
+ if not Header_File and then
+ Config.Naming_Data.Body_Suffix /= No_File
+ then
+ declare
+ Impl_Suffix : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Body_Suffix);
+
+ begin
+ if Filename'Length > Impl_Suffix'Length
+ and then
+ Filename
+ (Last - Impl_Suffix'Length + 1 .. Last) =
+ Impl_Suffix
+ then
+ Kind := Impl;
+
+ if Current_Verbosity = High then
+ Write_Str (" source of language ");
+ Write_Line
+ (Get_Name_String
+ (Display_Language_Name));
+ end if;
+
+ return;
+ end if;
+ end;
+ end if;
+
+ if Config.Naming_Data.Spec_Suffix /= No_File then
+ declare
+ Spec_Suffix : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Spec_Suffix);
+
+ begin
+ if Filename'Length > Spec_Suffix'Length
+ and then
+ Filename
+ (Last - Spec_Suffix'Length + 1 .. Last) =
+ Spec_Suffix
+ then
+ Kind := Spec;
+
+ if Current_Verbosity = High then
+ Write_Str
+ (" header file of language ");
+ Write_Line
+ (Get_Name_String
+ (Display_Language_Name));
+ end if;
+
+ if Header_File then
+ Alternate_Language_Table.Increment_Last
+ (In_Tree.Alt_Langs);
+ In_Tree.Alt_Langs.Table
+ (Alternate_Language_Table.Last
+ (In_Tree.Alt_Langs)) :=
+ (Language => Language,
+ Next => Alternate_Languages);
+ Alternate_Languages :=
+ Alternate_Language_Table.Last
+ (In_Tree.Alt_Langs);
+ else
+ Header_File := True;
+ First_Language := Language;
+ end if;
+ end if;
+ end;
+ end if;
+
+ elsif not Header_File then
+ -- Unit based language
+
+ OK := Config.Naming_Data.Dot_Replacement /= No_File;
+
+ if OK then
+ -- Check casing
+
+ case Config.Naming_Data.Casing is
+ when All_Lower_Case =>
+ for J in Filename'Range loop
+ if Is_Letter (Filename (J)) then
+ if not Is_Lower (Filename (J)) then
+ OK := False;
+ exit;
+ end if;
+ end if;
+ end loop;
+
+ when All_Upper_Case =>
+ for J in Filename'Range loop
+ if Is_Letter (Filename (J)) then
+ if not Is_Upper (Filename (J)) then
+ OK := False;
+ exit;
+ end if;
+ end if;
+ end loop;
+
+ when others =>
+ OK := False;
+ end case;
+ end if;
+
+ if OK then
+ OK := False;
+
+ if Config.Naming_Data.Separate_Suffix /= No_File
+ and then
+ Config.Naming_Data.Separate_Suffix /=
+ Config.Naming_Data.Body_Suffix
+ then
+ declare
+ Suffix : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Separate_Suffix);
+
+ begin
+ if Filename'Length > Suffix'Length
+ and then
+ Filename
+ (Last - Suffix'Length + 1 .. Last) =
+ Suffix
+ then
+ Kind := Sep;
+ Last := Last - Suffix'Length;
+ OK := True;
+ end if;
+ end;
+ end if;
+
+ if not OK and then
+ Config.Naming_Data.Body_Suffix /= No_File
+ then
+ declare
+ Suffix : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Body_Suffix);
+
+ begin
+ if Filename'Length > Suffix'Length
+ and then
+ Filename
+ (Last - Suffix'Length + 1 .. Last) =
+ Suffix
+ then
+ Kind := Impl;
+ Last := Last - Suffix'Length;
+ OK := True;
+ end if;
+ end;
+ end if;
+
+ if not OK and then
+ Config.Naming_Data.Spec_Suffix /= No_File
+ then
+ declare
+ Suffix : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Spec_Suffix);
+
+ begin
+ if Filename'Length > Suffix'Length
+ and then
+ Filename
+ (Last - Suffix'Length + 1 .. Last) =
+ Suffix
+ then
+ Kind := Spec;
+ Last := Last - Suffix'Length;
+ OK := True;
+ end if;
+ end;
+ end if;
+ end if;
+
+ if OK then
+ -- Replace dot replacements with dots
+
+ Name_Len := 0;
+
+ declare
+ J : Positive := Filename'First;
+ Dot_Replacement : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Dot_Replacement);
+ Max : constant Positive :=
+ Last - Dot_Replacement'Length + 1;
+
+ begin
+ loop
+ Name_Len := Name_Len + 1;
+
+ if J <= Max and then
+ Filename
+ (J .. J + Dot_Replacement'Length - 1) =
+ Dot_Replacement
+ then
+ Name_Buffer (Name_Len) := '.';
+ J := J + Dot_Replacement'Length;
+ else
+ if Filename (J) = '.' then
+ OK := False;
+ exit;
+ end if;
+
+ Name_Buffer (Name_Len) :=
+ GNAT.Case_Util.To_Lower (Filename (J));
+ J := J + 1;
+ end if;
+
+ exit when J > Last;
+ end loop;
+ end;
+ end if;
+
+ if OK then
+ -- The name buffer should contain the name of the
+ -- the unit, if it is one.
+ -- Check that this is a valid unit name
+
+ Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
+
+ if Unit /= No_Name then
+
+ if Current_Verbosity = High then
+ if Kind = Spec then
+ Write_Str (" spec of ");
+
+ else
+ Write_Str (" body of ");
+ end if;
+
+ Write_Str (Get_Name_String (Unit));
+ Write_Str (" (language ");
+ Write_Str
+ (Get_Name_String (Display_Language_Name));
+ Write_Line (")");
+ end if;
+
+ return;
+ end if;
+ end if;
+ end if;
+ end if;
+
+ Language := In_Tree.Languages_Data.Table (Language).Next;
+ end loop;
+
+ Lang := In_Tree.Name_Lists.Table (Lang).Next;
+ end loop;
+
+ if Header_File then
+ Language := First_Language;
+
+ else
+ Language := No_Language_Index;
+
+ if Current_Verbosity = High then
+ Write_Line (" not a source of any language");
+ end if;
+ end if;
+ end Check_Naming_Schemes;
+
+ begin
+ if Current_Verbosity = High then
+ Write_Line ("Looking for sources:");
+ end if;
+
+ -- For each subdirectory
+
+ while Source_Dir /= Nil_String loop
+ begin
+ Element := In_Tree.String_Elements.Table (Source_Dir);
+ if Element.Value /= No_Name then
+ Get_Name_String (Element.Display_Value);
+
+ declare
+ Source_Directory : constant String :=
+ Name_Buffer (1 .. Name_Len) &
+ Directory_Separator;
+ Dir_Last : constant Natural :=
+ Compute_Directory_Last
+ (Source_Directory);
+
+ begin
+ if Current_Verbosity = High then
+ Write_Str ("Source_Dir = ");
+ Write_Line (Source_Directory);
+ end if;
+
+ -- We look to every entry in the source directory
+
+ Open (Dir, Source_Directory
+ (Source_Directory'First .. Dir_Last));
+
+ loop
+ Read (Dir, Name, Last);
+
+ exit when Last = 0;
+
+ if Is_Regular_File
+ (Source_Directory & Name (1 .. Last))
+ then
+
+ if Current_Verbosity = High then
+ Write_Str (" Checking ");
+ Write_Line (Name (1 .. Last));
+ end if;
+
+ Source_To_Replace := No_Source;
+
+ Name_Len := Last;
+ Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
+ Display_File_Name := Name_Find;
+ Canonical_Case_File_Name
+ (Name_Buffer (1 .. Name_Len));
+ File_Name := Name_Find;
+
+ declare
+ Display_Path : constant String :=
+ Normalize_Pathname
+ (Name =>
+ Name (1 .. Last),
+ Directory =>
+ Source_Directory
+ (Source_Directory'First ..
+ Dir_Last),
+ Resolve_Links =>
+ Follow_Links,
+ Case_Sensitive => True);
+ Path : String := Display_Path;
+ Path_Id : Path_Name_Type;
+ Display_Path_Id : Path_Name_Type;
+
+ begin
+ Canonical_Case_File_Name (Path);
+ Name_Len := Path'Length;
+ Name_Buffer (1 .. Name_Len) := Path;
+ Path_Id := Name_Find;
+
+ Name_Len := Display_Path'Length;
+ Name_Buffer (1 .. Name_Len) := Display_Path;
+ Display_Path_Id := Name_Find;
+
+ Name_Loc := Source_Names.Get (File_Name);
+ Check_Name := False;
+
+ if Name_Loc = No_Name_Location then
+ Check_Name := For_All_Sources;
+
+ else
+ if Name_Loc.Found then
+ -- Check if it is allowed to have the
+ -- same file name in several source
+ -- directories.
+
+ if
+ not Data.Known_Order_Of_Source_Dirs
+ then
+ Error_Msg_File_1 := File_Name;
+ Error_Msg
+ (Project, In_Tree,
+ "{ is found in several " &
+ "source directories",
+ Name_Loc.Location);
+ end if;
+
+ else
+ Name_Loc.Found := True;
+
+ if Name_Loc.Source = No_Source then
+ Check_Name := True;
+
+ else
+ In_Tree.Sources.Table
+ (Name_Loc.Source).Path := Path_Id;
+
+ Source_Paths_Htable.Set
+ (In_Tree.Source_Paths_HT,
+ Path_Id,
+ Name_Loc.Source);
+
+ In_Tree.Sources.Table
+ (Name_Loc.Source).Display_Path :=
+ Display_Path_Id;
+
+ -- Check if this is a subunit
+
+ if In_Tree.Sources.Table
+ (Name_Loc.Source).Unit /= No_Name
+ and then
+ In_Tree.Sources.Table
+ (Name_Loc.Source).Kind = Impl
+ then
+ declare
+ Src_Ind : Source_File_Index;
+
+ begin
+ Src_Ind :=
+ Sinput.P.Load_Project_File
+ (Get_Name_String (Path_Id));
+
+ if Sinput.P.Source_File_Is_Subunit
+ (Src_Ind)
+ then
+ In_Tree.Sources.Table
+ (Name_Loc.Source).Kind :=
+ Sep;
+ end if;
+ end;
+ end if;
+ end if;
+ end if;
+ end if;
+
+ if Check_Name then
+ Alternate_Languages := No_Alternate_Language;
+ Check_Naming_Schemes;
+
+ if Language = No_Language_Index then
+ if Name_Loc.Found then
+ -- A file name in a list must be
+ -- a source of a language.
+
+ Error_Msg_File_1 := File_Name;
+ Error_Msg
+ (Project, In_Tree,
+ "language unknown for {",
+ Name_Loc.Location);
+ end if;
+
+ else
+ -- Check if the same file name or unit
+ -- is used in the project tree.
+
+ Source := In_Tree.First_Source;
+ Add_Src := True;
+
+ while Source /= No_Source loop
+ Src_Data :=
+ In_Tree.Sources.Table (Source);
+
+ if (Unit /= No_Name and then
+ Src_Data.Unit = Unit and then
+ Src_Data.Kind = Kind)
+ or else
+ (Unit = No_Name and then
+ Src_Data.File = File_Name)
+ then
+ -- Duplication of file/unit in the
+ -- same project is only allowed if
+ -- the order of source directories
+ -- is known.
+
+ if Project = Src_Data.Project then
+ if
+ Data.Known_Order_Of_Source_Dirs
+ then
+ Add_Src := False;
+
+ elsif Unit /= No_Name then
+ Error_Msg_Name_1 := Unit;
+ Error_Msg
+ (Project, In_Tree,
+ "duplicate unit %%",
+ No_Location);
+ Add_Src := False;
+
+ else
+ Error_Msg_File_1 := File_Name;
+ Error_Msg
+ (Project, In_Tree,
+ "duplicate source file " &
+ "name {",
+ No_Location);
+ Add_Src := False;
+ end if;
+
+ -- Do not allow the same unit name
+ -- in different projects, except if
+ -- one is extending the other.
+
+ -- For a file based language,
+ -- the same file name replaces
+ -- a file in a project being
+ -- extended, but it is allowed
+ -- to have the same file name in
+ -- unrelated projects.
+
+ elsif Is_Extending
+ (Project,
+ Src_Data.Project,
+ In_Tree)
+ then
+ Source_To_Replace := Source;
+
+ elsif Unit /= No_Name then
+ Error_Msg_Name_1 := Unit;
+ Error_Msg
+ (Project, In_Tree,
+ "unit %% cannot belong to " &
+ "several projects",
+ No_Location);
+ Add_Src := False;
+ end if;
+ end if;
+
+ Source := Src_Data.Next_In_Sources;
+ end loop;
+
+ if Add_Src then
+ Source_Data_Table.Increment_Last
+ (In_Tree.Sources);
+ Source := Source_Data_Table.Last
+ (In_Tree.Sources);
+
+ declare
+ Data : Source_Data;
+ begin
+ Data.Project := Project;
+ Data.Language_Name := Language_Name;
+ Data.Language := Language;
+ Data.Alternate_Languages :=
+ Alternate_Languages;
+ Data.Kind := Kind;
+ Data.Unit := Unit;
+ Data.File := File_Name;
+ Data.Object :=
+ Object_Name (File_Name);
+ Data.Dependency :=
+ In_Tree.Languages_Data.Table
+ (Language).Config.Dependency_Kind;
+ Data.Dep_Name :=
+ Dependency_Name
+ (File_Name, Data.Dependency);
+ Data.Switches :=
+ Switches_Name (File_Name);
+ Data.Display_File :=
+ Display_File_Name;
+ Data.Path := Path_Id;
+ Data.Display_Path :=
+ Display_Path_Id;
+ In_Tree.Sources.Table (Source) :=
+ Data;
+ end;
+
+ Add_Source (Source, Data, In_Tree);
+
+ Source_Paths_Htable.Set
+ (In_Tree.Source_Paths_HT,
+ Path_Id,
+ Source);
+
+ if Source_To_Replace /= No_Source then
+ Remove_Source
+ (Source_To_Replace,
+ Source,
+ Project,
+ Data,
+ In_Tree);
+ end if;
+ end if;
+ end if;
+ end if;
+ end;
+ end if;
+ end loop;
+
+ Close (Dir);
+ end;
+ end if;
+
+ exception
+ when Directory_Error =>
+ null;
+ end;
+ Source_Dir := Element.Next;
+ end loop;
+
+ if Current_Verbosity = High then
+ Write_Line ("end Looking for sources.");
+ end if;
+
+ end Search_Directories;
+
begin
- if Data.Ada_Sources_Present then
+ if Get_Mode = Ada_Only and then
+ Is_A_Language (In_Tree, Data, "ada")
+ then
declare
Sources : constant Variable_Value :=
Util.Value_Of
Data.Ada_Sources_Present := Current /= Nil_String;
- while Current /= Nil_String loop
- Element := In_Tree.String_Elements.Table (Current);
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Name := Name_Find;
+ if Current = Nil_String then
+ Data.Source_Dirs := Nil_String;
- -- If the element has no location, then use the
- -- location of Sources to report possible errors.
+ -- This project contains no source. For projects that
+ -- don't extend other projects, this also means that
+ -- there is no need for an object directory, if not
+ -- specified.
- if Element.Location = No_Location then
- Location := Sources.Location;
- else
- Location := Element.Location;
+ if Data.Extends = No_Project
+ and then Data.Object_Directory = Data.Directory
+ then
+ Data.Object_Directory := No_Path;
end if;
- Source_Names.Set
- (K => Name,
- E =>
- (Name => Name,
- Location => Location,
- Found => False));
+ else
+ while Current /= Nil_String loop
+ Element :=
+ In_Tree.String_Elements.Table (Current);
+ Get_Name_String (Element.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Name := Name_Find;
- Current := Element.Next;
- end loop;
+ -- If the element has no location, then use the
+ -- location of Sources to report possible errors.
+
+ if Element.Location = No_Location then
+ Location := Sources.Location;
+ else
+ Location := Element.Location;
+ end if;
+
+ Source_Names.Set
+ (K => Name,
+ E =>
+ (Name => Name,
+ Location => Location,
+ Source => No_Source,
+ Except => False,
+ Found => False));
+
+ Current := Element.Next;
+ end loop;
- Get_Path_Names_And_Record_Sources (Follow_Links);
+ Get_Path_Names_And_Record_Sources (Follow_Links);
+ end if;
end;
-- No source_files specified
elsif not Source_List_File.Default then
- -- Source_List_File is the name of the file that contains the
- -- source file names
+ -- Source_List_File is the name of the file
+ -- that contains the source file names
declare
Source_File_Path_Name : constant String :=
if Source_File_Path_Name'Length = 0 then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Source_List_File.Value);
-
Error_Msg
(Project, In_Tree,
"file with sources { does not exist",
-- specified. Find all the files that satisfy the naming
-- scheme in all the source directories.
- Find_Sources
- (Project, In_Tree, Data, Ada_Language_Index, Follow_Links);
+ Find_Ada_Sources
+ (Project, In_Tree, Data, Follow_Links);
end if;
-- If there are sources that are locally removed, mark them as
-- such in the Units table.
if not Locally_Removed.Default then
+
declare
- Current : String_List_Id;
+ Current : String_List_Id := Locally_Removed.Values;
Element : String_Element;
Location : Source_Ptr;
OK : Boolean;
Extended : Project_Id;
begin
- Current := Locally_Removed.Values;
while Current /= Nil_String loop
Element :=
In_Tree.String_Elements.Table (Current);
-- Check that this is from the current project or
-- that the current project extends.
- Extended := Unit.File_Names (Specification).Project;
+ Extended := Unit.File_Names
+ (Specification).Project;
if Extended = Project or else
Project_Extends (Project, Extended, In_Tree)
end;
end if;
- if Data.Other_Sources_Present then
-
+ if Get_Mode = Ada_Only and then Data.Other_Sources_Present then
-- Set Source_Present to False. It will be set back to True
-- whenever a source is found.
(File_Id,
(Name => File_Id,
Location => Element.Location,
+ Source => No_Source,
+ Except => False,
Found => False));
end if;
E =>
(Name => Name,
Location => Location,
+ Source => No_Source,
+ Except => False,
Found => False));
Current := Element.Next;
end if;
end loop;
end if;
+
+ if Get_Mode = Multi_Language and then
+ Data.First_Language_Processing /= No_Language_Index
+ then
+ -- First, put all the naming exceptions, if any, in the Source_Names
+ -- table.
+
+ Source_Names.Reset;
+
+ declare
+ Source : Source_Id;
+ Src_Data : Source_Data;
+ Name_Loc : Name_Location;
+
+ begin
+ Source := Data.First_Source;
+
+ while Source /= No_Source loop
+ Src_Data := In_Tree.Sources.Table (Source);
+ Name_Loc := (Name => Src_Data.File,
+ Location => No_Location,
+ Source => Source,
+ Except => Src_Data.Unit /= No_Name,
+ Found => False);
+
+ if Current_Verbosity = High then
+ Write_Str ("Putting source #");
+ Write_Str (Source'Img);
+ Write_Str (", file ");
+ Write_Str (Get_Name_String (Src_Data.File));
+ Write_Line (" in Source_Names");
+ end if;
+
+ Source_Names.Set
+ (K => Src_Data.File,
+ E => Name_Loc);
+
+ Source := Src_Data.Next_In_Project;
+ end loop;
+ end;
+
+ -- Now check attributes Sources and Source_List_File
+
+ declare
+ Sources : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_Files,
+ Data.Decl.Attributes,
+ In_Tree);
+
+ Source_List_File : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_List_File,
+ Data.Decl.Attributes,
+ In_Tree);
+
+ Locally_Removed : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Locally_Removed_Files,
+ Data.Decl.Attributes,
+ In_Tree);
+ Name_Loc : Name_Location;
+
+ begin
+ if not Sources.Default then
+ if not Source_List_File.Default then
+ Error_Msg
+ (Project, In_Tree,
+ "?both variables source_files and " &
+ "source_list_file are present",
+ Source_List_File.Location);
+ end if;
+
+ -- Sources is a list of file names
+
+ declare
+ Current : String_List_Id := Sources.Values;
+ Element : String_Element;
+ Location : Source_Ptr;
+ Name : File_Name_Type;
+
+ begin
+ if Current = Nil_String then
+ Data.First_Language_Processing := No_Language_Index;
+
+ -- This project contains no source. For projects that
+ -- don't extend other projects, this also means that
+ -- there is no need for an object directory, if not
+ -- specified.
+
+ if Data.Extends = No_Project
+ and then Data.Object_Directory = Data.Directory
+ then
+ Data.Object_Directory := No_Path;
+ end if;
+ end if;
+
+ while Current /= Nil_String loop
+ Element :=
+ In_Tree.String_Elements.Table (Current);
+ Get_Name_String (Element.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Name := Name_Find;
+
+ -- If the element has no location, then use the
+ -- location of Sources to report possible errors.
+
+ if Element.Location = No_Location then
+ Location := Sources.Location;
+ else
+ Location := Element.Location;
+ end if;
+
+ Name_Loc := Source_Names.Get (Name);
+
+ if Name_Loc = No_Name_Location then
+ Name_Loc :=
+ (Name => Name,
+ Location => Location,
+ Source => No_Source,
+ Except => False,
+ Found => False);
+ Source_Names.Set (Name, Name_Loc);
+ end if;
+
+ Current := Element.Next;
+ end loop;
+ end;
+
+ elsif not Source_List_File.Default then
+ -- Source_List_File is the name of the file
+ -- that contains the source file names
+
+ declare
+ Source_File_Path_Name : constant String :=
+ Path_Name_Of
+ (File_Name_Type
+ (Source_List_File.Value),
+ Data.Directory);
+
+ begin
+ if Source_File_Path_Name'Length = 0 then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Source_List_File.Value);
+ Error_Msg
+ (Project, In_Tree,
+ "file with sources { does not exist",
+ Source_List_File.Location);
+
+ else
+ Get_Sources_From_File
+ (Source_File_Path_Name,
+ Source_List_File.Location);
+ end if;
+ end;
+ end if;
+
+ Search_Directories
+ (For_All_Sources =>
+ Sources.Default and then Source_List_File.Default);
+
+ -- If there are sources that are locally removed, mark them as
+ -- such.
+
+ if not Locally_Removed.Default then
+
+ declare
+ Current : String_List_Id := Locally_Removed.Values;
+ Element : String_Element;
+ Location : Source_Ptr;
+ OK : Boolean;
+ Name : File_Name_Type;
+ Source : Source_Id;
+ Src_Data : Source_Data;
+
+ begin
+ while Current /= Nil_String loop
+ Element :=
+ In_Tree.String_Elements.Table (Current);
+ Get_Name_String (Element.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Name := Name_Find;
+
+ -- If the element has no location, then use the
+ -- location of Locally_Removed to report
+ -- possible errors.
+
+ if Element.Location = No_Location then
+ Location := Locally_Removed.Location;
+ else
+ Location := Element.Location;
+ end if;
+
+ OK := False;
+
+ Source := In_Tree.First_Source;
+
+ while Source /= No_Source loop
+ Src_Data := In_Tree.Sources.Table (Source);
+
+ if Src_Data.File = Name then
+ -- Check that this is from this project or a
+ -- project that the current project extends.
+
+ if Src_Data.Project = Project or else
+ Is_Extending
+ (Project, Src_Data.Project, In_Tree)
+ then
+ Src_Data.Locally_Removed := True;
+ In_Tree.Sources.Table (Source) := Src_Data;
+ Add_Forbidden_File_Name (Name);
+ OK := True;
+ exit;
+ end if;
+ end if;
+
+ Source := Src_Data.Next_In_Sources;
+ end loop;
+
+ if not OK then
+ Err_Vars.Error_Msg_File_1 := Name;
+ Error_Msg
+ (Project, In_Tree, "unknown file {", Location);
+ end if;
+
+ Current := Element.Next;
+ end loop;
+ end;
+ end if;
+ end;
+ end if;
end Look_For_Sources;
------------------
function Path_Name_Of
(File_Name : File_Name_Type;
- Directory : Path_Name_Type) return String
+ Directory : Path_Name_Type)
+ return String
is
+ Result : String_Access;
+
The_Directory : constant String := Get_Name_String (Directory);
- Result : String_Access;
begin
Get_Name_String (File_Name);
- Result :=
- Locate_Regular_File
- (File_Name => Name_Buffer (1 .. Name_Len),
- Path => The_Directory);
+ Result := Locate_Regular_File
+ (File_Name => Name_Buffer (1 .. Name_Len),
+ Path => The_Directory);
if Result = null then
return "";
if Element.Index /= No_Name then
Unit :=
(Kind => Kind,
- Unit => Name_Id (Element.Index),
+ Unit => Element.Index,
Next => No_Ada_Naming_Exception);
Reverse_Ada_Naming_Exceptions.Set
(Unit, (Element.Value.Value, Element.Value.Index));
Unit.Next :=
- (Ada_Naming_Exceptions.Get
- (File_Name_Type (Element.Value.Value)));
+ Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value));
Ada_Naming_Exception_Table.Increment_Last;
Ada_Naming_Exception_Table.Table
(Ada_Naming_Exception_Table.Last) := Unit;
procedure Record_Ada_Source
(File_Name : File_Name_Type;
- Path_Name : File_Name_Type;
+ Path_Name : Path_Name_Type;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
Follow_Links : Boolean)
is
Canonical_File_Name : File_Name_Type;
- Canonical_Path_Name : File_Name_Type;
+ Canonical_Path_Name : Path_Name_Type;
Exception_Id : Ada_Naming_Exception_Id;
Unit_Name : Name_Id;
Unit_Kind : Spec_Or_Body;
- Unit_Index : Int := 0;
+ Unit_Ind : Int := 0;
Info : Unit_Info;
Name_Index : Name_And_Index;
Needs_Pragma : Boolean;
Canonical_Path_Name := Name_Find;
end;
- -- Find out unit name/unit kind and if it needs a specific SFN pragma
+ -- Find out the unit name, the unit kind and if it needs
+ -- a specific SFN pragma.
Get_Unit
- (Canonical_File_Name => Canonical_File_Name,
+ (In_Tree => In_Tree,
+ Canonical_File_Name => Canonical_File_Name,
Naming => Data.Naming,
Exception_Id => Exception_Id,
Unit_Name => Unit_Name,
Info.Next := No_Ada_Naming_Exception;
Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
- Unit_Name := Info.Unit;
- Unit_Index := Name_Index.Index;
- Unit_Kind := Info.Kind;
+ Unit_Name := Info.Unit;
+ Unit_Ind := Name_Index.Index;
+ Unit_Kind := Info.Kind;
end if;
-- Put the file name in the list of sources of the project
- String_Element_Table.Increment_Last (In_Tree.String_Elements);
+ String_Element_Table.Increment_Last
+ (In_Tree.String_Elements);
In_Tree.String_Elements.Table
(String_Element_Table.Last
(In_Tree.String_Elements)) :=
Location => No_Location,
Flag => False,
Next => Nil_String,
- Index => Unit_Index);
+ Index => Unit_Ind);
if Current_Source = Nil_String then
- Data.Sources :=
- String_Element_Table.Last (In_Tree.String_Elements);
+ Data.Ada_Sources := String_Element_Table.Last
+ (In_Tree.String_Elements);
+ Data.Sources := Data.Ada_Sources;
else
- In_Tree.String_Elements.Table (Current_Source).Next :=
- String_Element_Table.Last (In_Tree.String_Elements);
+ In_Tree.String_Elements.Table
+ (Current_Source).Next :=
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
end if;
- Current_Source :=
- String_Element_Table.Last (In_Tree.String_Elements);
+ Current_Source := String_Element_Table.Last
+ (In_Tree.String_Elements);
-- Put the unit in unit list
declare
- The_Unit : Unit_Id :=
- Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
-
+ The_Unit : Unit_Index :=
+ Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
The_Unit_Data : Unit_Data;
begin
-- only the other unit kind (spec or body), or what is
-- in the unit list is a unit of a project we are extending.
- if The_Unit /= No_Unit then
+ if The_Unit /= No_Unit_Index then
The_Unit_Data := In_Tree.Units.Table (The_Unit);
if (The_Unit_Data.File_Names (Unit_Kind).Name =
- Canonical_File_Name
- and then
- The_Unit_Data.File_Names (Unit_Kind).Path = Slash)
+ Canonical_File_Name
+ and then
+ The_Unit_Data.File_Names (Unit_Kind).Path = Slash)
or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
or else Project_Extends
(Data.Extends,
Unit_Prj := (Unit => The_Unit, Project => Project);
Files_Htable.Set
- (In_Tree.Files_HT, Canonical_File_Name, Unit_Prj);
+ (In_Tree.Files_HT,
+ Canonical_File_Name,
+ Unit_Prj);
The_Unit_Data.File_Names (Unit_Kind) :=
(Name => Canonical_File_Name,
- Index => Unit_Index,
+ Index => Unit_Ind,
Display_Name => File_Name,
Path => Canonical_Path_Name,
Display_Path => Path_Name,
Project => Project,
Needs_Pragma => Needs_Pragma);
- In_Tree.Units.Table (The_Unit) := The_Unit_Data;
+ In_Tree.Units.Table (The_Unit) :=
+ The_Unit_Data;
Source_Recorded := True;
elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
Canonical_Path_Name)
then
if Previous_Source = Nil_String then
+ Data.Ada_Sources := Nil_String;
Data.Sources := Nil_String;
else
In_Tree.String_Elements.Table
if The_Location = No_Location then
The_Location :=
- In_Tree.Projects.Table (Project).Location;
+ In_Tree.Projects.Table
+ (Project).Location;
end if;
Err_Vars.Error_Msg_Name_1 := Unit_Name;
In_Tree.Projects.Table
(The_Unit_Data.File_Names (Unit_Kind).Project).Name;
Err_Vars.Error_Msg_File_1 :=
- The_Unit_Data.File_Names (Unit_Kind).Path;
+ File_Name_Type
+ (The_Unit_Data.File_Names (Unit_Kind).Path);
Error_Msg
(Project, In_Tree,
- "\\ project file %%, {", The_Location);
+ "\ project file %%, {", The_Location);
Err_Vars.Error_Msg_Name_1 :=
In_Tree.Projects.Table (Project).Name;
- Err_Vars.Error_Msg_File_1 := Canonical_Path_Name;
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Canonical_Path_Name);
Error_Msg
(Project, In_Tree,
- "\\ project file %%, {", The_Location);
+ "\ project file %%, {", The_Location);
end if;
-- It is a new unit, create a new record
then
Error_Msg_File_1 := File_Name;
Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Unit_Prj.Project).Name;
+ In_Tree.Projects.Table
+ (Unit_Prj.Project).Name;
Error_Msg
(Project, In_Tree,
"{ is already a source of project %%",
else
Unit_Table.Increment_Last (In_Tree.Units);
The_Unit := Unit_Table.Last (In_Tree.Units);
- Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit);
+ Units_Htable.Set
+ (In_Tree.Units_HT, Unit_Name, The_Unit);
Unit_Prj := (Unit => The_Unit, Project => Project);
Files_Htable.Set
- (In_Tree.Files_HT, Canonical_File_Name, Unit_Prj);
+ (In_Tree.Files_HT,
+ Canonical_File_Name,
+ Unit_Prj);
The_Unit_Data.Name := Unit_Name;
The_Unit_Data.File_Names (Unit_Kind) :=
(Name => Canonical_File_Name,
- Index => Unit_Index,
+ Index => Unit_Ind,
Display_Name => File_Name,
Path => Canonical_Path_Name,
Display_Path => Path_Name,
Project => Project,
Needs_Pragma => Needs_Pragma);
- In_Tree.Units.Table (The_Unit) := The_Unit_Data;
+ In_Tree.Units.Table (The_Unit) :=
+ The_Unit_Data;
Source_Recorded := True;
end if;
end if;
is
Source_Dir : String_List_Id;
Element : String_Element;
- Path : File_Name_Type;
+ Path : Path_Name_Type;
Dir : Dir_Type;
Canonical_Name : File_Name_Type;
Name_Str : String (1 .. 1_024);
NL : Name_Location;
First_Error : Boolean := True;
- Suffix : constant String := Body_Suffix_Of (Language, Data, In_Tree);
+ Suffix : constant String :=
+ Body_Suffix_Of (Language, Data, In_Tree);
begin
Source_Dir := Data.Source_Dirs;
end if;
end Record_Other_Sources;
- ---------------------------
- -- Report_No_Ada_Sources --
- ---------------------------
+ -------------------
+ -- Remove_Source --
+ -------------------
- procedure Report_No_Ada_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Location : Source_Ptr)
+ procedure Remove_Source
+ (Id : Source_Id;
+ Replaced_By : Source_Id;
+ Project : Project_Id;
+ Data : in out Project_Data;
+ In_Tree : Project_Tree_Ref)
+ is
+ Src_Data : constant Source_Data := In_Tree.Sources.Table (Id);
+
+ Source : Source_Id;
+
+ begin
+ if Current_Verbosity = High then
+ Write_Str ("Removing source #");
+ Write_Line (Id'Img);
+ end if;
+
+ In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
+ -- Remove the source from the global list
+
+ Source := In_Tree.First_Source;
+
+ if Source = Id then
+ In_Tree.First_Source := Src_Data.Next_In_Sources;
+
+ else
+ while In_Tree.Sources.Table (Source).Next_In_Sources /= Id loop
+ Source := In_Tree.Sources.Table (Source).Next_In_Sources;
+ end loop;
+
+ In_Tree.Sources.Table (Source).Next_In_Sources :=
+ Src_Data.Next_In_Sources;
+ end if;
+
+ -- Remove the source from the project list
+
+ if Src_Data.Project = Project then
+ Source := Data.First_Source;
+
+ if Source = Id then
+ Data.First_Source := Src_Data.Next_In_Project;
+
+ if Src_Data.Next_In_Project = No_Source then
+ Data.Last_Source := No_Source;
+ end if;
+
+ else
+ while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
+ Source := In_Tree.Sources.Table (Source).Next_In_Project;
+ end loop;
+
+ In_Tree.Sources.Table (Source).Next_In_Project :=
+ Src_Data.Next_In_Project;
+
+ if Src_Data.Next_In_Project = No_Source then
+ In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
+ end if;
+ end if;
+
+ else
+ Source := In_Tree.Projects.Table (Src_Data.Project).First_Source;
+
+ if Source = Id then
+ In_Tree.Projects.Table (Src_Data.Project).First_Source :=
+ Src_Data.Next_In_Project;
+
+ if Src_Data.Next_In_Project = No_Source then
+ In_Tree.Projects.Table (Src_Data.Project).Last_Source :=
+ No_Source;
+ end if;
+
+ else
+ while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
+ Source := In_Tree.Sources.Table (Source).Next_In_Project;
+ end loop;
+
+ In_Tree.Sources.Table (Source).Next_In_Project :=
+ Src_Data.Next_In_Project;
+
+ if Src_Data.Next_In_Project = No_Source then
+ In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
+ end if;
+ end if;
+ end if;
+
+ -- Remove source from the language list
+
+ Source := In_Tree.Languages_Data.Table (Src_Data.Language).First_Source;
+
+ if Source = Id then
+ In_Tree.Languages_Data.Table (Src_Data.Language).First_Source :=
+ Src_Data.Next_In_Lang;
+
+ else
+ while In_Tree.Sources.Table (Source).Next_In_Lang /= Id loop
+ Source := In_Tree.Sources.Table (Source).Next_In_Lang;
+ end loop;
+
+ In_Tree.Sources.Table (Source).Next_In_Lang :=
+ Src_Data.Next_In_Lang;
+ end if;
+
+ end Remove_Source;
+
+ -----------------------
+ -- Report_No_Sources --
+ -----------------------
+
+ procedure Report_No_Sources
+ (Project : Project_Id;
+ Lang_Name : String;
+ In_Tree : Project_Tree_Ref;
+ Location : Source_Ptr)
is
begin
case When_No_Sources is
when Warning | Error =>
Error_Msg_Warn := When_No_Sources = Warning;
-
Error_Msg
(Project, In_Tree,
- "<there are no Ada sources in this project",
+ "<there are no " & Lang_Name & " sources in this project",
Location);
end case;
- end Report_No_Ada_Sources;
+ end Report_No_Sources;
----------------------
-- Show_Source_Dirs --
----------------------
procedure Show_Source_Dirs
- (Project : Project_Id;
+ (Data : Project_Data;
In_Tree : Project_Tree_Ref)
is
Current : String_List_Id;
begin
Write_Line ("Source_Dirs:");
- Current := In_Tree.Projects.Table (Project).Source_Dirs;
+ Current := Data.Source_Dirs;
while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current);
Write_Str (" ");
is
Conv : Array_Element_Id := Conventions;
Unit : Name_Id;
- The_Unit_Id : Unit_Id;
+ The_Unit_Id : Unit_Index;
The_Unit_Data : Unit_Data;
Location : Source_Ptr;
Get_Name_String (Unit);
To_Lower (Name_Buffer (1 .. Name_Len));
Unit := Name_Find;
- The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit);
- Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
+ The_Unit_Id := Units_Htable.Get
+ (In_Tree.Units_HT, Unit);
+ Location := In_Tree.Array_Elements.Table
+ (Conv).Value.Location;
- if The_Unit_Id = No_Unit then
+ if The_Unit_Id = No_Unit_Index then
Error_Msg
(Project, In_Tree,
"?unknown unit %%",
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- 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.
--
- -- When_No_Ada_Sources indicates what should be done when no Ada sources
- -- are found in a project where Ada is a language.
+ -- When_No_Sources indicates what should be done when no sources of a
+ -- language are found in a project where this language is declared.
end Prj.Nmsc;
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
with Prj.Part;
with Prj.Proc;
with Prj.Tree; use Prj.Tree;
+with Sinput.P;
package body Prj.Pars is
Project : out Project_Id;
Project_File_Name : String;
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
Project_Node_Tree : constant Project_Node_Tree_Ref :=
new Project_Node_Tree_Data;
-- Parse the main project file into a tree
+ Sinput.P.Reset_First;
Prj.Part.Parse
(In_Tree => Project_Node_Tree,
Project => Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Report_Error => null,
Follow_Links => Opt.Follow_Links,
- When_No_Sources => When_No_Sources);
+ When_No_Sources => When_No_Sources,
+ Reset_Tree => Reset_Tree);
Prj.Err.Finalize;
if not Success then
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
Project : out Project_Id;
Project_File_Name : String;
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
-- project tree In_Tree.
--
--
-- When_No_Sources indicates what should be done when no sources
-- 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;
with Snames;
with Table;
-with Ada.Characters.Handling; use Ada.Characters.Handling;
-with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Ada.Exceptions; use Ada.Exceptions;
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with System.HTable; use System.HTable;
+with System.HTable; use System.HTable;
package body Prj.Part is
Buffer : String_Access;
Buffer_Last : Natural := 0;
- Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
-
- type Extension_Origin is (None, Extending_Simple, Extending_All);
- -- 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.
+ Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
------------------------------------
-- Local Packages and Subprograms --
No_With : constant With_Id := 0;
type With_Record is record
- Path : File_Name_Type;
+ Path : Path_Name_Type;
Location : Source_Ptr;
Limited_With : Boolean;
Node : Project_Node_Id;
Canonical_Path_Name : Path_Name_Type;
Id : Project_Node_Id;
end record;
- -- Needs a comment ???
package Project_Stack is new Table.Table
(Table_Component_Type => Names_And_Id,
Project_Directory : Path_Name_Type;
From_Extended : Extension_Origin;
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,
-- if any. From_Extended is used for the call to Parse_Single_Project
-- below. When In_Limited is True, the importing path includes at least
-- one "limited with".
- procedure Parse_Single_Project
- (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
(Project_File_Name : String;
Directory : String) return String;
-- This includes the directory separator as the last character.
-- 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 No_Name if the path name is invalid, because the corresponding
-- project name does not have the syntax of an ada identifier.
----------------------------
function Immediate_Directory_Of
- (Path_Name : Path_Name_Type) return Path_Name_Type
+ (Path_Name : Path_Name_Type)
+ return Path_Name_Type
is
begin
Get_Name_String (Path_Name);
Project := Empty_Node;
if Current_Verbosity >= Medium then
- Write_Str ("ADA_PROJECT_PATH=""");
+ Write_Str ("GPR_PROJECT_PATH=""");
Write_Str (Project_Path);
Write_Line ("""");
end if;
Extended => False,
From_Extended => None,
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
-- virtual extending projects and check that there are no illegally
Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
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
Scan (In_Tree); -- scan past LIMITED
Expect (Tok_With, "WITH");
-- Store path and location in table Withs
Current_With :=
- (Path => File_Name_Type (Token_Name),
+ (Path => Path_Name_Type (Token_Name),
Location => Token_Ptr,
Limited_With => Limited_With,
Node => Current_With_Node,
Project_Directory : Path_Name_Type;
From_Extended : Extension_Origin;
In_Limited : Boolean;
- Packages_To_Check : String_List_Access)
+ Packages_To_Check : String_List_Access;
+ Depth : Natural)
is
- Current_With_Clause : With_Id;
+ Current_With_Clause : With_Id := Context_Clause;
Current_Project : Project_Node_Id := Empty_Node;
Previous_Project : Project_Node_Id := Empty_Node;
begin
Imported_Projects := Empty_Node;
- Current_With_Clause := Context_Clause;
while Current_With_Clause /= No_With loop
Current_With := Withs.Table (Current_With_Clause);
Current_With_Clause := Current_With.Next;
-- 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);
-- If this is not imported by the main project file,
Extended => False,
From_Extended => From_Extended,
In_Limited => Limited_With,
- Packages_To_Check => Packages_To_Check);
+ Packages_To_Check => Packages_To_Check,
+ Depth => Depth);
else
Extends_All := Is_Extending_All (Withed_Project, In_Tree);
Extended : Boolean;
From_Extended : Extension_Origin;
In_Limited : Boolean;
- Packages_To_Check : String_List_Access)
+ Packages_To_Check : String_List_Access;
+ Depth : Natural)
is
Normed_Path_Name : Path_Name_Type;
Canonical_Path_Name : Path_Name_Type;
Extending : Boolean := False;
- Extended_Project : Project_Node_Id := Empty_Node;
+ Extended_Project : Project_Node_Id := Empty_Node;
A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT);
- Name_From_Path : constant File_Name_Type :=
- Project_Name_From (Path_Name);
+ Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
Name_Of_Project : Name_Id := No_Name;
Project_Stack.Table (Index).Canonical_Path_Name
then
Error_Msg ("circular dependency detected", Token_Ptr);
- Error_Msg_File_1 := File_Name_Type (Normed_Path_Name);
- Error_Msg ("\\ { is imported by", Token_Ptr);
+ Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
+ Error_Msg ("\ %% is imported by", Token_Ptr);
for Current in reverse 1 .. Project_Stack.Last loop
- Error_Msg_File_1 :=
- File_Name_Type (Project_Stack.Table (Current).Path_Name);
+ Error_Msg_Name_1 :=
+ Name_Id (Project_Stack.Table (Current).Path_Name);
if Project_Stack.Table (Current).Canonical_Path_Name /=
Canonical_Path_Name
then
Error_Msg
- ("\\ { which itself is imported by", Token_Ptr);
+ ("\ %% which itself is imported by", Token_Ptr);
else
- Error_Msg ("\\ {", Token_Ptr);
+ Error_Msg ("\ %%", Token_Ptr);
exit;
end if;
end loop;
Tree.Reset_State;
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,
-- or not following Ada identifier's syntax).
Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
- Error_Msg ("?{ is not a valid path name for a project file",
- Token_Ptr);
+
+ 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",
+ Token_Ptr);
+ end if;
end if;
if Current_Verbosity >= Medium then
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.
exit when Token /= Tok_Dot;
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
Create_Mapping_File := True;
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
declare
- Expected_Name : constant File_Name_Type := Name_Find;
+ Expected_Name : constant Name_Id := Name_Find;
+ Extension : String_Access;
begin
-- 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
then
- Error_Msg_File_1 := Expected_Name;
- Error_Msg ("?file name does not match unit name, " &
- "should be `{" & Project_File_Extension & "`",
+ Error_Msg_Name_1 := Expected_Name;
+
+ 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);
end if;
end;
Project_Directory => Project_Directory,
From_Extended => From_Ext,
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);
end;
declare
Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
- Tree_Private_Part.Projects_Htable.Get_First
- (In_Tree.Projects_HT);
-
+ Tree_Private_Part.Projects_Htable.Get_First
+ (In_Tree.Projects_HT);
Project_Name : Name_Id := Name_And_Node.Name;
begin
Error_Msg_Name_1 := Project_Name;
Error_Msg
("duplicate project name %%", Location_Of (Project, In_Tree));
- Error_Msg_File_1 :=
- File_Name_Type (Path_Name_Of (Name_And_Node.Node, In_Tree));
+ Error_Msg_Name_1 :=
+ Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
Error_Msg
- ("\already in {", Location_Of (Project, In_Tree));
+ ("\already in %%", Location_Of (Project, In_Tree));
else
-- Otherwise, add the name of the project to the hash table, so
if Token = Tok_String_Literal then
Set_Extended_Project_Path_Of
- (Project, In_Tree, Path_Name_Type (Token_Name));
+ (Project,
+ In_Tree,
+ Path_Name_Type (Token_Name));
declare
Original_Path_Name : constant String :=
-- We could not find the project file to extend
- Error_Msg_File_1 := File_Name_Type (Token_Name);
- Error_Msg ("unknown project file: {", Token_Ptr);
+ Error_Msg_Name_1 := Token_Name;
+
+ Error_Msg ("unknown project file: %%", Token_Ptr);
-- If we are not in the main project file, display the
-- import path.
if Project_Stack.Last > 1 then
- Error_Msg_File_1 :=
- File_Name_Type
+ Error_Msg_Name_1 :=
+ Name_Id
(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
- Error_Msg_File_1 :=
- File_Name_Type
+ Error_Msg_Name_1 :=
+ Name_Id
(Project_Stack.Table (Index).Path_Name);
- Error_Msg ("\imported by {", Token_Ptr);
+ Error_Msg ("\imported by %%", Token_Ptr);
end loop;
end if;
Extended => True,
From_Extended => From_Ext,
In_Limited => In_Limited,
- Packages_To_Check => Packages_To_Check);
+ Packages_To_Check => Packages_To_Check,
+ Depth => Depth + 1);
end;
-- A project that extends an extending-all project is also
Imported := Project_Node_Of (With_Clause, In_Tree);
if Is_Extending_All (With_Clause, In_Tree) then
- Error_Msg_File_1 :=
- File_Name_Type (Name_Of (Imported, In_Tree));
- Error_Msg ("cannot import extending-all project {",
+ Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
+ Error_Msg ("cannot import extending-all project %%",
Token_Ptr);
exit With_Clause_Loop;
end if;
Name_Len := Name_Len - 1;
declare
- Parent_Name : constant File_Name_Type := Name_Find;
+ Parent_Name : constant Name_Id := Name_Find;
Parent_Found : Boolean := False;
With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project, In_Tree);
if Extended_Project /= Empty_Node then
Parent_Found :=
- Name_Of (Extended_Project, In_Tree) = Name_Id (Parent_Name);
+ Name_Of (Extended_Project, In_Tree) = Parent_Name;
end if;
-- If the parent project is not the extended project,
while not Parent_Found and then With_Clause /= Empty_Node loop
Parent_Found :=
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);
end loop;
if not Parent_Found then
Error_Msg_Name_1 := Name_Of_Project;
- Error_Msg_File_1 := Parent_Name;
- Error_Msg ("project %% does not import or extend project {",
+ Error_Msg_Name_2 := Parent_Name;
+ Error_Msg ("project %% does not import or extend project %%",
Location_Of (Project, In_Tree));
end if;
end;
-- 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;
First : Natural := Canonical'Last;
Last : Natural := First;
-- If the path name is empty, return No_Name to indicate failure
if First = 0 then
- return No_File;
+ return No_Name;
end if;
Canonical_Case_File_Name (Canonical);
-- If we have a dot, check that it is followed by the correct extension
if First > 0 and then Canonical (First) = '.' then
- if Canonical (First .. Last) = Project_File_Extension
- and then First /= 1
+ if ((not In_Configuration) and then
+ 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
-- Look for the last directory separator, if any
else
-- Not the correct extension, return No_Name to indicate failure
- return No_File;
+ return No_Name;
end if;
-- If no dot in the path name, return No_Name to indicate failure
else
- return No_File;
+ return No_Name;
end if;
First := First + 1;
-- If the extension is the file name, return No_Name to indicate failure
if First > Last then
- return No_File;
+ return No_Name;
end if;
-- Put the name in lower case into Name_Buffer
loop
if not Is_Letter (Name_Buffer (Index)) then
- return No_File;
+ return No_Name;
else
loop
if Name_Buffer (Index) = '_' then
if Name_Buffer (Index + 1) = '_' then
- return No_File;
+ return No_Name;
end if;
end if;
if Name_Buffer (Index) /= '_'
and then not Is_Alphanumeric (Name_Buffer (Index))
then
- return No_File;
+ return No_Name;
end if;
end loop;
return Name_Find;
else
- return No_File;
+ return No_Name;
end if;
elsif Name_Buffer (Index) = '-' then
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- unknown attribute produces a warning. When Store_Comments is True,
-- 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;
with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
+with Prj.Util; use Prj.Util;
with Sinput; use Sinput;
with Snames;
Equal => "=");
-- 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);
-- Concatenate two strings and returns another string if both
-- arguments are not null string.
procedure Add_Attributes
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Decl : in out Declarations;
- First : Attribute_Node_Id);
+ (Project : Project_Id;
+ Project_Name : Name_Id;
+ In_Tree : Project_Tree_Ref;
+ Decl : in out Declarations;
+ First : Attribute_Node_Id;
+ Project_Level : Boolean);
-- Add all attributes, starting with First, with their default
-- values to the package or project with declarations Decl.
procedure Check
(In_Tree : Project_Tree_Ref;
- Project : in out Project_Id;
+ Project : Project_Id;
Follow_Links : Boolean;
When_No_Sources : Error_Warning);
-- Set all projects to not checked, then call Recursive_Check for the
--------------------
procedure Add_Attributes
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Decl : in out Declarations;
- First : Attribute_Node_Id)
+ (Project : Project_Id;
+ Project_Name : Name_Id;
+ In_Tree : Project_Tree_Ref;
+ Decl : in out Declarations;
+ First : Attribute_Node_Id;
+ Project_Level : Boolean)
is
The_Attribute : Attribute_Node_Id := First;
Value => Empty_String,
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
when List =>
procedure Check
(In_Tree : Project_Tree_Ref;
- Project : in out Project_Id;
+ Project : Project_Id;
Follow_Links : Boolean;
When_No_Sources : Error_Warning)
is
In_Tree.Projects.Table (Index).Checked := False;
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;
-------------------------------
when N_Variable_Reference | N_Attribute_Reference =>
declare
- The_Project : Project_Id := Project;
- The_Package : Package_Id := Pkg;
- The_Name : Name_Id := No_Name;
- The_Variable_Id : Variable_Id := No_Variable;
+ The_Project : Project_Id := Project;
+ The_Package : Package_Id := Pkg;
+ The_Name : Name_Id := No_Name;
+ The_Variable_Id : Variable_Id := No_Variable;
The_Variable : Variable_Value;
Term_Project : constant Project_Node_Id :=
Project_Node_Of
Package_Node_Of
(The_Current_Term,
From_Project_Node_Tree);
- Index : Name_Id := No_Name;
+ Index : Name_Id := No_Name;
begin
if Term_Project /= Empty_Node and then
The_Name :=
Name_Of (Term_Project, From_Project_Node_Tree);
-
The_Project := Imported_Or_Extended_Project_From
(Project => Project,
In_Tree => In_Tree,
The_Name :=
Name_Of (Term_Package, From_Project_Node_Tree);
-
The_Package := In_Tree.Projects.Table
(The_Project).Decl.Packages;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean := True;
- When_No_Sources : Error_Warning := Error)
+ When_No_Sources : Error_Warning := Error;
+ Reset_Tree : Boolean := True)
is
Obj_Dir : Path_Name_Type;
Extending : 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
Error_Report := Report_Error;
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);
+ end if;
- Project_Table.Set_Last (In_Tree.Projects, No_Project);
Processed_Projects.Reset;
-- And process the main project and all of the projects it depends on,
- -- recursively
+ -- recursively.
Recursive_Process
(Project => Project,
From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => No_Project);
- if Project /= No_Project then
- Check (In_Tree, Project, Follow_Links, When_No_Sources);
- end if;
+ if not In_Configuration then
- -- If main project is an extending all project, set the object
- -- directory of all virtual extending projects to the object directory
- -- of the main project.
+ if Project /= No_Project then
+ Check
+ (In_Tree, Project, Follow_Links, When_No_Sources);
+ end if;
- if Project /= No_Project
- and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
- then
- declare
- Object_Dir : constant Path_Name_Type :=
- In_Tree.Projects.Table (Project).Object_Directory;
- begin
- for Index in
+ -- If main project is an extending all project, set the object
+ -- directory of all virtual extending projects to the object
+ -- directory of the main project.
+
+ if Project /= No_Project
+ and then
+ Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
+ then
+ declare
+ Object_Dir : constant Path_Name_Type :=
+ In_Tree.Projects.Table
+ (Project).Object_Directory;
+ begin
+ for Index in
+ Project_Table.First .. Project_Table.Last (In_Tree.Projects)
+ loop
+ if In_Tree.Projects.Table (Index).Virtual then
+ In_Tree.Projects.Table (Index).Object_Directory :=
+ Object_Dir;
+ end if;
+ end loop;
+ end;
+ end if;
+
+ -- Check that no extending project shares its object directory with
+ -- the project(s) it extends.
+
+ if Project /= No_Project then
+ for Proj in
Project_Table.First .. Project_Table.Last (In_Tree.Projects)
loop
- if In_Tree.Projects.Table (Index).Virtual then
- In_Tree.Projects.Table (Index).Object_Directory :=
- Object_Dir;
+ Extending := In_Tree.Projects.Table (Proj).Extended_By;
+
+ if Extending /= No_Project then
+ Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory;
+
+ -- Check that a project being extended does not share its
+ -- object directory with any project that extends it,
+ -- directly or indirectly, including a virtual extending
+ -- project.
+
+ -- Start with the project directly extending it
+
+ Extending2 := Extending;
+ while Extending2 /= No_Project loop
+ if In_Tree.Projects.Table (Extending2).Ada_Sources /=
+ Nil_String
+ and then
+ In_Tree.Projects.Table (Extending2).Object_Directory =
+ Obj_Dir
+ then
+ if In_Tree.Projects.Table (Extending2).Virtual then
+ Error_Msg_Name_1 :=
+ In_Tree.Projects.Table (Proj).Display_Name;
+
+ if Error_Report = null then
+ Error_Msg
+ ("project %% cannot be extended by a virtual" &
+ " project with the same object directory",
+ In_Tree.Projects.Table (Proj).Location);
+ else
+ Error_Report
+ ("project """ &
+ Get_Name_String (Error_Msg_Name_1) &
+ """ cannot be extended by a virtual " &
+ "project with the same object directory",
+ Project, In_Tree);
+ end if;
+
+ else
+ Error_Msg_Name_1 :=
+ In_Tree.Projects.Table (Extending2).Display_Name;
+ Error_Msg_Name_2 :=
+ In_Tree.Projects.Table (Proj).Display_Name;
+
+ if Error_Report = null then
+ Error_Msg
+ ("project %% cannot extend project %%",
+ In_Tree.Projects.Table (Extending2).Location);
+ Error_Msg
+ ("\they share the same object directory",
+ In_Tree.Projects.Table (Extending2).Location);
+
+ else
+ Error_Report
+ ("project """ &
+ Get_Name_String (Error_Msg_Name_1) &
+ """ cannot extend project """ &
+ Get_Name_String (Error_Msg_Name_2) & """",
+ Project, In_Tree);
+ Error_Report
+ ("they share the same object directory",
+ Project, In_Tree);
+ end if;
+ end if;
+ end if;
+
+ -- Continue with the next extending project, if any
+
+ Extending2 :=
+ In_Tree.Projects.Table (Extending2).Extended_By;
+ end loop;
end if;
end loop;
- end;
- end if;
+ end if;
- -- Check that no extending project shares its object directory with
- -- the project(s) it extends.
+ -- Get the global configuration
- if Project /= No_Project then
- for Proj in
- Project_Table.First .. Project_Table.Last (In_Tree.Projects)
- loop
- Extending := In_Tree.Projects.Table (Proj).Extended_By;
+ if Project /= No_Project then
- if Extending /= No_Project then
- Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory;
+ Process_Attributes
+ (In_Tree.Projects.Table (Project).Decl.Attributes);
- -- Check that a project being extended does not share its
- -- object directory with any project that extends it, directly
- -- or indirectly, including a virtual extending project.
+ -- Loop through packages ???
- -- Start with the project directly extending it
+ Packages := In_Tree.Projects.Table (Project).Decl.Packages;
+ while Packages /= No_Package loop
+ Element := In_Tree.Packages.Table (Packages);
- Extending2 := Extending;
- while Extending2 /= No_Project loop
- if In_Tree.Projects.Table (Extending2).Ada_Sources_Present
- and then
- In_Tree.Projects.Table (Extending2).Object_Directory =
- Obj_Dir
- then
- if In_Tree.Projects.Table (Extending2).Virtual then
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Proj).Display_Name;
+ case Element.Name is
+ when Snames.Name_Builder =>
- if Error_Report = null then
- Error_Msg
- ("project % cannot be extended by a virtual " &
- "project with the same object directory",
- In_Tree.Projects.Table (Proj).Location);
- else
- Error_Report
- ("project """ &
- Get_Name_String (Error_Msg_Name_1) &
- """ cannot be extended by a virtual " &
- "project with the same object directory",
- Project, In_Tree);
- end if;
+ -- Process attributes of package Builder
- else
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Extending2).Display_Name;
- Error_Msg_Name_2 :=
- In_Tree.Projects.Table (Proj).Display_Name;
+ Process_Attributes (Element.Decl.Attributes);
- if Error_Report = null then
- Error_Msg
- ("project %% cannot extend project %%",
- In_Tree.Projects.Table (Extending2).Location);
- Error_Msg
- ("\they share the same object directory",
- In_Tree.Projects.Table (Extending2).Location);
+ when Snames.Name_Linker =>
- else
- Error_Report
- ("project """ &
- Get_Name_String (Error_Msg_Name_1) &
- """ cannot extend project """ &
- Get_Name_String (Error_Msg_Name_2) & """",
- Project, In_Tree);
- Error_Report
- ("they share the same object directory",
- Project, In_Tree);
- end if;
- end if;
- end if;
+ -- Process attributes of package Linker
- -- Continue with the next extending project, if any
+ Process_Attributes (Element.Decl.Attributes);
- Extending2 :=
- In_Tree.Projects.Table (Extending2).Extended_By;
- end loop;
- end if;
- end loop;
+ when others =>
+ null;
+ end case;
+
+ Packages := Element.Next;
+ end loop;
+ end if;
end if;
Success :=
Pkg : Package_Id;
Item : Project_Node_Id)
is
- Current_Declarative_Item : Project_Node_Id := Item;
- Current_Item : Project_Node_Id := Empty_Node;
+ Current_Declarative_Item : Project_Node_Id;
+ Current_Item : Project_Node_Id;
begin
- -- For each declarative item
+ -- Loop through declarative items
+
+ Current_Item := Empty_Node;
+ Current_Declarative_Item := Item;
while Current_Declarative_Item /= Empty_Node loop
-- Get its data
case Kind_Of (Current_Item, From_Project_Node_Tree) is
when N_Package_Declaration =>
+
-- Do not process a package declaration that should be ignored
if Expression_Kind_Of
-- Set the default values of the attributes
Add_Attributes
- (Project, In_Tree,
+ (Project,
+ In_Tree.Projects.Table (Project).Name,
+ In_Tree,
In_Tree.Packages.Table (New_Pkg).Decl,
First_Attribute_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
From_Project_Node_Tree);
-- The name of the attribute
- New_Array : Array_Id;
+ New_Array : Array_Id;
-- The new associative array created
Orig_Array : Array_Id;
-- Find the project where the value is declared
Orig_Project_Name :=
- Name_Of
- (Associative_Project_Of
- (Current_Item, From_Project_Node_Tree),
- From_Project_Node_Tree);
+ Name_Of
+ (Associative_Project_Of
+ (Current_Item, From_Project_Node_Tree),
+ From_Project_Node_Tree);
for Index in Project_Table.First ..
Project_Table.Last
if Error_Report = null then
Error_Msg
- ("no value defined for %",
+ ("no value defined for %%",
Location_Of
(Current_Item, From_Project_Node_Tree));
if Error_Report = null then
Error_Msg
- ("value %% is illegal for "
- & "typed string %",
+ ("value %% is illegal " &
+ "for typed string %%",
Location_Of
(Current_Item,
From_Project_Node_Tree));
Get_Name_String (Error_Msg_Name_2) &
"""",
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;
Location_Of (From_Project_Node, From_Project_Node_Tree);
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);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Processed_Data.Directory := Name_Find;
Processed_Data.Extended_By := Extended_By;
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 :=
First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree);
-
while With_Clause /= Empty_Node loop
declare
New_Project : Project_Id;
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
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
-- Report_Error is null, use the error reporting mechanism. Otherwise,
-- report errors using Report_Error.
-- When_No_Sources indicates what should be done when no sources
-- 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???
end Prj.Proc;
Choices_Initial : constant := 10;
Choices_Increment : constant := 100;
+ -- These should be in alloc.ads
Choice_Node_Low_Bound : constant := 0;
Choice_Node_High_Bound : constant := 099_999_999;
(Reference, In_Tree, To => Variable_Kind_Of (Current_Attribute));
Set_Case_Insensitive
(Reference, In_Tree,
- To => Attribute_Kind_Of (Current_Attribute) =
- Case_Insensitive_Associative_Array);
+ To => Attribute_Kind_Of (Current_Attribute) in
+ Case_Insensitive_Associative_Array ..
+ Optional_Index_Case_Insensitive_Associative_Array);
-- Scan past the attribute name
Choice_First := 0;
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);
Choices.Set_Last (Choice_Lasts.Table (1));
case Token is
when Tok_Right_Paren =>
-
- -- Scan past the right parenthesis
- Scan (In_Tree);
+ Scan (In_Tree); -- scan past right paren
when Tok_Comma =>
-
- -- Scan past the comma
-
- Scan (In_Tree);
+ Scan (In_Tree); -- scan past comma
-- Get the string expression for the default
Expect (Tok_Right_Paren, "`)`");
- -- Scan past the right parenthesis
-
if Token = Tok_Right_Paren then
- Scan (In_Tree);
+ Scan (In_Tree); -- scan past right paren
end if;
when others =>
Found := False;
for Choice in Choice_First .. Choices.Last loop
if Choices.Table (Choice).The_String = Choice_String then
+
-- This label is part of the string type
Found := True;
if Choices.Table (Choice).Already_Used then
+
-- 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 ("duplicate case label %%", Token_Ptr);
+
else
Choices.Table (Choice).Already_Used := True;
end if;
-- If there is no '|', we are done
if Token = Tok_Vertical_Bar then
+
-- Otherwise, declare the node of the next choice, link it to
-- Current_Choice and set Current_Choice to this new node.
begin
while Current /= Last_String loop
if String_Value_Of (Current, In_Tree) = String_Value then
+
-- This is a repetition, report an error
Error_Msg_Name_1 := String_Value;
-- Now, look if it can be a project name
- The_Project := Imported_Or_Extended_Project_Of
- (Current_Project, In_Tree, Names.Table (1).Name);
+ 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);
+ end if;
if The_Project = Empty_Node then
+
-- If it is neither a project name nor a package name,
- -- report an error
+ -- report an error.
if First_Attribute = Empty_Attribute then
Error_Msg_Name_1 := Names.Table (1).Name;
First_Attribute := Attribute_First;
else
- -- If it is a package name, check if the package
- -- has already been declared in the current project.
+ -- If it is a package name, check if the package has
+ -- already been declared in the current project.
The_Package :=
First_Package_Of (Current_Project, In_Tree);
while The_Package /= Empty_Node
and then Name_Of (The_Package, In_Tree) /=
- Names.Table (1).Name
+ Names.Table (1).Name
loop
The_Package :=
Next_Package_In_Project (The_Package, In_Tree);
-- Check if the long project is imported or extended
- The_Project := Imported_Or_Extended_Project_Of
- (Current_Project, In_Tree, Long_Project);
+ if Long_Project = Name_Of (Current_Project, In_Tree) then
+ 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
-- of the attribute.
-- Otherwise, check if the short project is imported
-- or extended.
- The_Project := Imported_Or_Extended_Project_Of
- (Current_Project, In_Tree,
- Short_Project);
+ if Short_Project =
+ Name_Of (Current_Project, In_Tree)
+ then
+ The_Project := Current_Project;
- -- If the short project does not exist, we report an
- -- error.
+ else
+ The_Project := Imported_Or_Extended_Project_Of
+ (Current_Project, In_Tree,
+ Short_Project);
+ end if;
+
+ -- If short project does not exist, report an error
if The_Project = Empty_Node then
Error_Msg_Name_1 := Long_Project;
case Names.Last is
when 0 =>
- -- Cannot happen
+ -- Cannot happen (so why null instead of raise PE???)
null;
-- First check for a possible project name
- The_Project := Imported_Or_Extended_Project_Of
- (Current_Project, In_Tree, Short_Project);
+ The_Project :=
+ Imported_Or_Extended_Project_Of
+ (Current_Project, In_Tree, Short_Project);
if The_Project = Empty_Node then
-- Unknown prefix, report an error
Error_Msg_Name_1 := Long_Project;
Error_Msg_Name_2 := Short_Project;
- Error_Msg ("unknown projects % or %",
- Names.Table (1).Location);
+ Error_Msg
+ ("unknown projects % or %",
+ Names.Table (1).Location);
Look_For_Variable := False;
else
end loop;
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 ("unknown package %",
if Specified_Project /= Empty_Node then
The_Project := Specified_Project;
-
else
The_Project := Current_Project;
end if;
if Specified_Package /= Empty_Node then
Current_Variable :=
First_Variable_Of (Specified_Package, In_Tree);
-
while Current_Variable /= Empty_Node
and then
Name_Of (Current_Variable, In_Tree) /= Variable_Name
then
Current_Variable :=
First_Variable_Of (Current_Package, In_Tree);
-
while Current_Variable /= Empty_Node
and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop
if Current_Variable = Empty_Node then
Current_Variable := First_Variable_Of (The_Project, In_Tree);
-
while Current_Variable /= Empty_Node
and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop
(Variable, In_Tree,
To => Expression_Kind_Of (Current_Variable, In_Tree));
- if
- Kind_Of (Current_Variable, In_Tree) = N_Typed_Variable_Declaration
+ if Kind_Of (Current_Variable, In_Tree) =
+ N_Typed_Variable_Declaration
then
Set_String_Type_Of
(Variable, In_Tree,
Current_String : Project_Node_Id;
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.
if Choice_First = 0 then
Choice_First := Choices.Last + 1;
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
Current_String := First_Literal_String (String_Type, In_Tree);
-
while Current_String /= Empty_Node loop
Add (This_String => String_Value_Of (Current_String, In_Tree));
Current_String := Next_Literal_String (Current_String, In_Tree);
Choice_Lasts.Increment_Last;
Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last;
-
end Start_New_Case_Construction;
-----------
Scan (In_Tree);
else
- -- Otherwise, we parse the expression(s) in the literal string
- -- list.
+ -- Otherwise parse the expression(s) in the literal string list
loop
Current_Location := Token_Ptr;
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.
Current_Location := Token_Ptr;
end if;
when Tok_External =>
+
-- An external reference is always a single string
if Expr_Kind = Undefined then
-- If there is an '&', call Terms recursively
if Token = Tok_Ampersand then
-
- -- Scan past the '&'
-
- Scan (In_Tree);
+ Scan (In_Tree); -- scan past ampersand
Terms
(In_Tree => In_Tree,
with GNAT.Dynamic_HTables;
with GNAT.Dynamic_Tables;
+with Table;
+
with Prj.Attr; use Prj.Attr;
package Prj.Tree is
-- The following query functions are part of the abstract interface
-- of the Project File tree. They provide access to fields of a project.
- -- In the following, there are "valid if" comments, but no indication
- -- of what happens if they are called with invalid arguments ???
+ -- The access functions should be called only with valid 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
(Node : Project_Node_Id;
-- Node of the project in table Project_Nodes
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;
-- True when the project is being extended by another project
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 Output; use Output;
Free (File);
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 --
-----------------
Executable_Suffix : Variable_Value := Nil_Variable_Value;
- Body_Append : constant String := Get_Name_String
- (In_Tree.Projects.Table
- (Project).
- Naming.Ada_Body_Suffix);
+ Executable_Suffix_Name : Name_Id := No_Name;
- Spec_Append : constant String := Get_Name_String
- (In_Tree.Projects.Table
- (Project).
- Naming.Ada_Spec_Suffix);
+ Naming : constant Naming_Data := In_Tree.Projects.Table (Project).Naming;
+
+ Body_Suffix : constant String :=
+ Body_Suffix_Of (In_Tree, "ada", Naming);
+
+ Spec_Suffix : constant String :=
+ Spec_Suffix_Of (In_Tree, "ada", Naming);
begin
if Builder_Package /= No_Package then
- Executable_Suffix := Prj.Util.Value_Of
- (Variable_Name => Name_Executable_Suffix,
- In_Variables => In_Tree.Packages.Table
- (Builder_Package).Decl.Attributes,
- In_Tree => In_Tree);
+ if Get_Mode = Multi_Language then
+ Executable_Suffix_Name := In_Tree.Config.Executable_Suffix;
+
+ else
+ Executable_Suffix := Prj.Util.Value_Of
+ (Variable_Name => Name_Executable_Suffix,
+ In_Variables => In_Tree.Packages.Table
+ (Builder_Package).Decl.Attributes,
+ 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
Get_Name_String (Main);
Name_Buffer (1 .. 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;
begin
Result : File_Name_Type;
begin
- if Executable_Suffix /= Nil_Variable_Value
- and then not Executable_Suffix.Default
- then
- Executable_Extension_On_Target := Executable_Suffix.Value;
+ if Executable_Suffix_Name /= No_Name then
+ Executable_Extension_On_Target := Executable_Suffix_Name;
end if;
- Result := Executable_Name (File_Name_Type (Executable.Value));
+ Result := Executable_Name (File_Name_Type (Executable.Value));
Executable_Extension_On_Target := Saved_EEOT;
return Result;
end;
-- otherwise remove any suffix ('.' followed by other characters), if
-- there is one.
- if Ada_Main and then Name_Len > Body_Append'Length
- and then Name_Buffer (Name_Len - Body_Append'Length + 1 .. Name_Len) =
- Body_Append
+ if Ada_Main and then Name_Len > Body_Suffix'Length
+ and then Name_Buffer (Name_Len - Body_Suffix'Length + 1 .. Name_Len) =
+ Body_Suffix
then
-- 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
- and then Name_Buffer (Name_Len - Spec_Append'Length + 1 .. Name_Len) =
- Spec_Append
+ elsif Ada_Main and then Name_Len > Spec_Suffix'Length
+ and then Name_Buffer (Name_Len - Spec_Suffix'Length + 1 .. Name_Len) =
+ Spec_Suffix
then
-- Found the spec termination, remove it
- Name_Len := Name_Len - Spec_Append'Length;
+ Name_Len := Name_Len - Spec_Suffix'Length;
else
-- Remove any suffix, if there is one
end;
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.
- return Executable_Name (Name_Find);
+ declare
+ Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
+ Result : File_Name_Type;
+
+ 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 Executable_Of;
File_Name (File_Name'Last) := ASCII.NUL;
FD := Open_Read (Name => File_Name'Address,
Fmode => GNAT.OS_Lib.Text);
+
if FD = Invalid_FD then
File := null;
+
else
File := new Text_File_Data;
File.FD := FD;
end if;
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 --
--------------
end Value_Of;
function Value_Of
- (Index : Name_Id;
- In_Array : Array_Element_Id;
- In_Tree : Project_Tree_Ref) return Name_Id
+ (Index : Name_Id;
+ In_Array : Array_Element_Id;
+ In_Tree : Project_Tree_Ref) return Name_Id
is
- Current : Array_Element_Id := In_Array;
+ Current : Array_Element_Id;
Element : Array_Element;
Real_Index : Name_Id := Index;
begin
+ Current := In_Array;
+
if Current = No_Array_Element then
return No_Name;
end if;
end Value_Of;
function Value_Of
- (Index : Name_Id;
- Src_Index : Int := 0;
- In_Array : Array_Element_Id;
- In_Tree : Project_Tree_Ref) return Variable_Value
+ (Index : Name_Id;
+ Src_Index : Int := 0;
+ In_Array : Array_Element_Id;
+ In_Tree : Project_Tree_Ref;
+ Force_Lower_Case_Index : Boolean := False) return Variable_Value
is
- Current : Array_Element_Id := In_Array;
- Element : Array_Element;
- Real_Index : Name_Id := Index;
+ Current : Array_Element_Id;
+ Element : Array_Element;
+ Real_Index : Name_Id;
begin
+ Current := In_Array;
+
if Current = No_Array_Element then
return Nil_Variable_Value;
end if;
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);
To_Lower (Name_Buffer (1 .. Name_Len));
Real_Index := Name_Find;
Index : Int := 0;
Attribute_Or_Array_Name : Name_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
The_Array : Array_Element_Id;
The_Attribute : Variable_Value := Nil_Variable_Value;
In_Tree => In_Tree);
The_Attribute :=
Value_Of
- (Index => Name,
- Src_Index => Index,
- In_Array => The_Array,
- In_Tree => In_Tree);
+ (Index => Name,
+ Src_Index => Index,
+ In_Array => The_Array,
+ In_Tree => In_Tree,
+ Force_Lower_Case_Index => Force_Lower_Case_Index);
-- If there is no array element, look for a variable
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
- Current : Array_Id := In_Arrays;
+ Current : Array_Id;
The_Array : Array_Data;
begin
+ Current := In_Arrays;
while Current /= No_Array loop
The_Array := In_Tree.Arrays.Table (Current);
if The_Array.Name = In_Array then
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Array_Element_Id
is
- Current : Array_Id := In_Arrays;
- The_Array : Array_Data;
+ Current : Array_Id;
+ The_Array : Array_Data;
begin
+ Current := In_Arrays;
while Current /= No_Array loop
The_Array := In_Tree.Arrays.Table (Current);
In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id
is
- Current : Package_Id := In_Packages;
+ Current : Package_Id;
The_Package : Package_Element;
begin
+ Current := In_Packages;
while Current /= No_Package loop
The_Package := In_Tree.Packages.Table (Current);
exit when The_Package.Name /= No_Name
In_Variables : Variable_Id;
In_Tree : Project_Tree_Ref) return Variable_Value
is
- Current : Variable_Id := In_Variables;
+ Current : Variable_Id;
The_Variable : Variable;
begin
+ Current := In_Variables;
while Current /= No_Variable loop
The_Variable :=
In_Tree.Variable_Elements.Table (Current);
-- Executable_Suffix is specified, add this suffix, otherwise add the
-- 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
(Variable : Variable_Value;
Default : String) return String;
-- associative array.
function Value_Of
- (Index : Name_Id;
- Src_Index : Int := 0;
- In_Array : Array_Element_Id;
- In_Tree : Project_Tree_Ref) return Variable_Value;
+ (Index : Name_Id;
+ Src_Index : Int := 0;
+ In_Array : Array_Element_Id;
+ 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
-- Nil_Variable_Value if no component Index or if In_Array is null.
--
Index : Int := 0;
Attribute_Or_Array_Name : Name_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,
-- - if there exists an array Attribute_Or_Array_Name with an index Name,
-- returns the corresponding component (depending on the attribute, the
with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Debug;
with Output; use Output;
with Osint; use Osint;
with Prj.Attr;
with Snames; use Snames;
with Uintp; use Uintp;
-with GNAT.Case_Util; use GNAT.Case_Util;
+with System.Case_Util; use System.Case_Util;
package body Prj is
+ Object_Suffix : constant String := Get_Target_Object_Suffix.all;
+ -- File suffix for object files
+
Initial_Buffer_Size : constant := 100;
-- Initial size for extensible buffer used in Add_To_Buffer
+ Current_Mode : Mode := Ada_Only;
+
+ Configuration_Mode : Boolean := False;
+
The_Empty_String : Name_Id;
Name_C_Plus_Plus : Name_Id;
Default_Ada_Spec_Suffix_Id : File_Name_Type;
Default_Ada_Body_Suffix_Id : File_Name_Type;
- Slash_Id : File_Name_Type;
- -- Initialized in Prj.Initialized, then never modified
+ Slash_Id : Path_Name_Type;
+ -- Initialized in Prj.Initialize, then never modified
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
File_Name_Type
(First_Name_Id + Character'Pos ('-'));
- Std_Naming_Data : Naming_Data :=
- (Dot_Replacement => Standard_Dot_Replacement,
- Dot_Repl_Loc => No_Location,
- Casing => All_Lower_Case,
- Spec_Suffix => No_Array_Element,
- Ada_Spec_Suffix => No_File,
- Spec_Suffix_Loc => No_Location,
- Impl_Suffixes => No_Impl_Suffixes,
- Supp_Suffixes => No_Supp_Language_Index,
- Body_Suffix => No_Array_Element,
- Ada_Body_Suffix => No_File,
- Body_Suffix_Loc => No_Location,
- Separate_Suffix => No_File,
- Sep_Suffix_Loc => No_Location,
- Specs => No_Array_Element,
- Bodies => No_Array_Element,
- Specification_Exceptions => No_Array_Element,
- Implementation_Exceptions => No_Array_Element);
-
- Project_Empty : Project_Data :=
+ Std_Naming_Data : constant Naming_Data :=
+ (Dot_Replacement => Standard_Dot_Replacement,
+ Dot_Repl_Loc => No_Location,
+ Casing => All_Lower_Case,
+ Spec_Suffix => No_Array_Element,
+ Ada_Spec_Suffix_Loc => No_Location,
+ Body_Suffix => No_Array_Element,
+ Ada_Body_Suffix_Loc => No_Location,
+ Separate_Suffix => No_File,
+ Sep_Suffix_Loc => No_Location,
+ Specs => No_Array_Element,
+ Bodies => No_Array_Element,
+ Specification_Exceptions => No_Array_Element,
+ Implementation_Exceptions => No_Array_Element,
+ Impl_Suffixes => No_Impl_Suffixes,
+ Supp_Suffixes => No_Supp_Language_Index);
+
+ Project_Empty : constant Project_Data :=
(Externally_Built => False,
- Languages => No_Languages,
- Supp_Languages => No_Supp_Language_Index,
+ Config => Default_Project_Config,
+ Languages => No_Name_List,
First_Referred_By => No_Project,
Name => No_Name,
Display_Name => No_Name,
Display_Library_Src_Dir => No_Path,
Library_ALI_Dir => No_Path,
Display_Library_ALI_Dir => No_Path,
- Library_Name => No_File,
+ Library_Name => No_Name,
Library_Kind => Static,
- Lib_Internal_Name => No_File,
+ Lib_Internal_Name => No_Name,
Standalone_Library => False,
Lib_Interface_ALIs => Nil_String,
Lib_Auto_Init => False,
Libgnarl_Needed => Unknown,
Symbol_Data => No_Symbols,
- Ada_Sources_Present => True,
- Other_Sources_Present => True,
+ Ada_Sources => Nil_String,
Sources => Nil_String,
- First_Other_Source => No_Other_Source,
- Last_Other_Source => No_Other_Source,
+ First_Source => No_Source,
+ Last_Source => No_Source,
+ Unit_Based_Language_Name => No_Name,
+ Unit_Based_Language_Index => No_Language_Index,
Imported_Directories_Switches => null,
Include_Path => null,
Include_Data_Set => False,
+ Include_Language => No_Language_Index,
Source_Dirs => Nil_String,
Known_Order_Of_Source_Dirs => True,
Object_Directory => No_Path,
Extends => No_Project,
Extended_By => No_Project,
Naming => Std_Naming_Data,
- First_Language_Processing => Default_First_Language_Processing_Data,
- Supp_Language_Processing => No_Supp_Language_Index,
- Default_Linker => No_File,
- Default_Linker_Path => No_Path,
+ First_Language_Processing => No_Language_Index,
Decl => No_Declarations,
Imported_Projects => Empty_Project_List,
All_Imported_Projects => Empty_Project_List,
Ada_Include_Path => null,
Ada_Objects_Path => null,
+ Objects_Path => null,
Include_Path_File => No_Path,
Objects_Path_File_With_Libs => No_Path,
Objects_Path_File_Without_Libs => No_Path,
Config_File_Name => No_Path,
Config_File_Temp => False,
+ Linker_Name => No_File,
+ Linker_Path => No_Path,
+ Minimum_Linker_Options => No_Name_List,
Config_Checked => False,
- Language_Independent_Checked => False,
Checked => False,
Seen => False,
Need_To_Build_Lib => False,
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 --
while Last + S'Length > To'Last loop
declare
- New_Buffer : constant String_Access := new String (1 .. 2 * Last);
+ New_Buffer : constant String_Access :=
+ new String (1 .. 2 * Last);
begin
New_Buffer (1 .. Last) := To (1 .. Last);
Last := Last + S'Length;
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 --
-----------------------------
return Default_Ada_Spec_Suffix_Id;
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 --
---------------------------
Write_Str (Name_Buffer (1 .. Name_Len));
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 --
-------------------
- 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;
+
begin
Prj.Initialize (Tree => No_Project_Tree);
Value := Project_Empty;
Value.Naming := Tree.Private_Part.Default_Naming;
+
+ if Current_Mode = Multi_Language then
+ Value.Config := Tree.Config;
+ end if;
+
return Value;
end Empty_Project;
end if;
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 --
--------------------------------
procedure Recursive_Check (Project : Project_Id) is
List : Project_List;
-
begin
if not In_Tree.Projects.Table (Project).Seen then
In_Tree.Projects.Table (Project).Seen := True;
Recursive_Check (Project => By);
end For_Every_Project_Imported;
+ --------------
+ -- Get_Mode --
+ --------------
+
+ function Get_Mode return Mode is
+ begin
+ return Current_Mode;
+ end Get_Mode;
+
----------
-- 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
begin
return Hash (Get_Name_String (Name));
end Hash;
- function Hash (Name : File_Name_Type) return Header_Num is
+ function Hash (Name : Path_Name_Type) return Header_Num is
begin
return Hash (Get_Name_String (Name));
end Hash;
return The_Casing_Images (Casing).all;
end Image;
+ ----------------------
+ -- In_Configuration --
+ ----------------------
+
+ function In_Configuration return Boolean is
+ begin
+ return Configuration_Mode;
+ end In_Configuration;
+
----------------
-- Initialize --
----------------
Name_Buffer (1 .. 3) := "c++";
Name_C_Plus_Plus := Name_Find;
- Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
- Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix;
- Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix;
- Project_Empty.Naming := Std_Naming_Data;
Prj.Env.Initialize;
Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
end if;
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 --
----------------
return False;
when First_Language_Indexes =>
- return In_Project.Languages (Language);
+ return In_Project.Langs (Language);
when others =>
declare
return Default_Language_Processing_Data;
when First_Language_Indexes =>
- return In_Project.First_Language_Processing (Language);
+ return In_Project.First_Lang_Processing (Language);
when others =>
declare
end case;
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 --
------------------------------------
Default_Body_Suffix : File_Name_Type;
In_Tree : Project_Tree_Ref)
is
- Lang : Name_Id;
- Suffix : Array_Element_Id;
- Found : Boolean := False;
+ Lang : Name_Id;
+ Suffix : Array_Element_Id;
+ Found : Boolean := False;
Element : Array_Element;
begin
Value => Name_Id (Default_Spec_Suffix),
Index => 0),
Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
-
Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
-
In_Tree.Array_Elements.Table
- (Array_Element_Table.Last (In_Tree.Array_Elements)) := Element;
-
+ (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
+ Element;
In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
Array_Element_Table.Last (In_Tree.Array_Elements);
end if;
-----------
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
Prj.Env.Initialize;
+
+ -- gprmake tables
+
Present_Language_Table.Init (Tree.Present_Languages);
Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
- Name_List_Table.Init (Tree.Name_Lists);
Supp_Language_Table.Init (Tree.Supp_Languages);
Other_Source_Table.Init (Tree.Other_Sources);
- String_Element_Table.Init (Tree.String_Elements);
- Variable_Element_Table.Init (Tree.Variable_Elements);
- Array_Element_Table.Init (Tree.Array_Elements);
- Array_Table.Init (Tree.Arrays);
- Package_Table.Init (Tree.Packages);
- Project_List_Table.Init (Tree.Project_Lists);
- Project_Table.Init (Tree.Projects);
- Unit_Table.Init (Tree.Units);
- Units_Htable.Reset (Tree.Units_HT);
- Files_Htable.Reset (Tree.Files_HT);
- Naming_Table.Init (Tree.Private_Part.Namings);
- Naming_Table.Increment_Last (Tree.Private_Part.Namings);
+
+ -- Visible tables
+
+ Language_Data_Table.Init (Tree.Languages_Data);
+ Name_List_Table.Init (Tree.Name_Lists);
+ String_Element_Table.Init (Tree.String_Elements);
+ Variable_Element_Table.Init (Tree.Variable_Elements);
+ Array_Element_Table.Init (Tree.Array_Elements);
+ Array_Table.Init (Tree.Arrays);
+ Package_Table.Init (Tree.Packages);
+ Project_List_Table.Init (Tree.Project_Lists);
+ Project_Table.Init (Tree.Projects);
+ Source_Data_Table.Init (Tree.Sources);
+ Alternate_Language_Table.Init (Tree.Alt_Langs);
+ Unit_Table.Init (Tree.Units);
+ Units_Htable.Reset (Tree.Units_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.Increment_Last (Tree.Private_Part.Namings);
Tree.Private_Part.Namings.Table
(Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
Path_File_Table.Init (Tree.Private_Part.Path_Files);
Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
Tree.Private_Part.Default_Naming := Std_Naming_Data;
- Register_Default_Naming_Scheme
- (Language => Name_Ada,
- Default_Spec_Suffix => Default_Ada_Spec_Suffix,
- Default_Body_Suffix => Default_Ada_Body_Suffix,
- In_Tree => Tree);
+
+ if Current_Mode = Ada_Only then
+ Register_Default_Naming_Scheme
+ (Language => Name_Ada,
+ Default_Spec_Suffix => Default_Ada_Spec_Suffix,
+ Default_Body_Suffix => Default_Ada_Body_Suffix,
+ In_Tree => Tree);
+ Tree.Private_Part.Default_Naming.Separate_Suffix :=
+ Default_Ada_Body_Suffix;
+ end if;
end Reset;
------------------------
begin
return Left.Dot_Replacement = Right.Dot_Replacement
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;
end Same_Naming_Scheme;
null;
when First_Language_Indexes =>
- In_Project.Languages (Language) := Present;
+ In_Project.Langs (Language) := Present;
when others =>
declare
null;
when First_Language_Indexes =>
- In_Project.First_Language_Processing (For_Language) :=
+ In_Project.First_Lang_Processing (For_Language) :=
Language_Processing;
when others =>
declare
Supp : Supp_Language_Data;
- Supp_Index : Supp_Language_Index :=
- In_Project.Supp_Language_Processing;
+ Supp_Index : Supp_Language_Index;
begin
+ Supp_Index := In_Project.Supp_Language_Processing;
while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Languages.Table (Supp_Index);
end case;
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 --
-----------
- function Slash return File_Name_Type is
+ function Slash return Path_Name_Type is
begin
return Slash_Id;
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 --
--------------------------
end case;
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 --
-----------
end Value;
begin
- -- Make sure that the standard project file extension is compatible
- -- with canonical case file naming.
+ -- Make sure that the standard config and user project file extensions are
+ -- compatible with canonical case file naming.
+ Canonical_Case_File_Name (Config_Project_File_Extension);
Canonical_Case_File_Name (Project_File_Extension);
end Prj;
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;
-- Default value of parameter Packages of procedures Parse, in Prj.Pars and
-- Prj.Part, indicating that all packages should be checked.
function Default_Ada_Spec_Suffix return File_Name_Type;
pragma Inline (Default_Ada_Spec_Suffix);
- -- The Name_Id for the standard GNAT suffix for Ada spec source file
- -- name ".ads". Initialized by Prj.Initialize.
+ -- The name for the standard GNAT suffix for Ada spec source file name
+ -- ".ads". Initialized by Prj.Initialize.
function Default_Ada_Body_Suffix return File_Name_Type;
pragma Inline (Default_Ada_Body_Suffix);
- -- The Name_Id for the standard GNAT suffix for Ada body source file
- -- name ".adb". Initialized by Prj.Initialize.
+ -- The name for the standard GNAT suffix for Ada body source file name
+ -- ".adb". Initialized by Prj.Initialize.
- function Slash return File_Name_Type;
+ function Slash return Path_Name_Type;
pragma Inline (Slash);
-- "/", used as the path of locally removed files
+ Config_Project_File_Extension : String := ".cgpr";
Project_File_Extension : String := ".gpr";
- -- The standard project file name extension. It is not a constant, because
- -- Canonical_Case_File_Name is called on this variable in the body of Prj.
+ -- The standard config and user project file name extensions. They are not
+ -- constants, because Canonical_Case_File_Name is called on these variables
+ -- in the body of Prj.
type Error_Warning is (Silent, Warning, Error);
-- Severity of some situations, such as: no Ada sources in a project where
-- - Warning: issue a warning, does not cause the tool to fail
-- - Error: issue an error, causes the tool to fail
- type Yes_No_Unknown is (Yes, No, Unknown);
- -- Tri-state to decide if -lgnarl is needed when linking
+ function Empty_File return File_Name_Type;
+ function Empty_String return Name_Id;
+ -- Return the id for an empty string ""
- -----------------------------------------------------
- -- Multi-language Stuff That Will be Modified Soon --
- -----------------------------------------------------
+ type Project_Id is new Nat;
+ 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;
- First_Language_Index : constant Language_Index := 1;
- First_Language_Indexes_Last : constant Language_Index := 5;
+ type Variable_Kind is (Undefined, List, Single);
+ -- Different kinds of variables
- Ada_Language_Index : constant Language_Index :=
- 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;
+ -- The defined kinds of variables
- 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
- range First_Language_Index .. First_Language_Indexes_Last;
+ type Variable_Value (Kind : Variable_Kind := Undefined) is record
+ 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;
- function Hash (Name : File_Name_Type) return Header_Num;
+ package Variable_Element_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Variable,
+ Table_Index_Type => Variable_Id,
+ Table_Low_Bound => 1,
+ Table_Initial => 200,
+ Table_Increment => 100);
+ -- The table of variable in list of variables
- package Language_Indexes is new System.HTable.Simple_HTable
- (Header_Num => Header_Num,
- Element => Language_Index,
- No_Element => No_Language_Index,
- Key => Name_Id,
- Hash => Hash,
- Equal => "=");
- -- Mapping of language names to language indexes
+ type Array_Element_Id is new Nat;
+ No_Array_Element : constant Array_Element_Id := 0;
+ type Array_Element is record
+ Index : Name_Id;
+ Src_Index : Int := 0;
+ Index_Case_Sensitive : Boolean := True;
+ Value : Variable_Value;
+ 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
- (Table_Component_Type => Name_Id,
- Table_Index_Type => Language_Index,
+ package Array_Element_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Array_Element,
+ Table_Index_Type => Array_Element_Id,
Table_Low_Bound => 1,
- Table_Initial => 4,
- Table_Increment => 100,
- Table_Name => "Prj.Language_Names");
- -- The table for the name of programming languages
-
- procedure Add_Language_Name (Name : Name_Id);
+ Table_Initial => 200,
+ Table_Increment => 100);
+ -- The table that contains all array elements
- 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;
- -- Set of supported languages used in a project
+ package Array_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Array_Data,
+ Table_Index_Type => Array_Id,
+ Table_Low_Bound => 1,
+ Table_Initial => 200,
+ Table_Increment => 100);
+ -- The table that contains all arrays
- No_Languages : constant Languages_In_Project := (others => False);
- -- No supported languages are used
+ type Package_Id is new Nat;
+ 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_Supp_Language_Index : constant Supp_Language_Index := 0;
+ No_Declarations : constant Declarations :=
+ (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
- Index : Language_Index := No_Language_Index;
- Present : Boolean := False;
- Next : Supp_Language_Index := No_Supp_Language_Index;
+ type Package_Element is record
+ Name : Name_Id := No_Name;
+ Decl : Declarations := No_Declarations;
+ Parent : Package_Id := No_Package;
+ Next : Package_Id := No_Package;
end record;
+ -- A package (includes declarations that may include other packages)
- package Present_Language_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Supp_Language,
- Table_Index_Type => Supp_Language_Index,
+ package Package_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Package_Element,
+ Table_Index_Type => Package_Id,
Table_Low_Bound => 1,
- Table_Initial => 4,
+ Table_Initial => 100,
Table_Increment => 100);
- -- The table for the presence of languages with an index that is outside
- -- of First_Language_Indexes.
+ -- The table that contains all packages
- type Impl_Suffix_Array is array (First_Language_Indexes) of File_Name_Type;
- -- Suffixes for the non spec sources of the different supported languages
- -- in a project.
+ type Language_Index is new Nat;
- No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_File);
- -- A default value for the non spec source suffixes
+ No_Language_Index : constant Language_Index := 0;
- 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;
+ procedure Display_Language_Name
+ (In_Tree : Project_Tree_Ref;
+ Language : Language_Index);
- package Supp_Suffix_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Supp_Suffix,
- Table_Index_Type => Supp_Language_Index,
- Table_Low_Bound => 1,
- Table_Initial => 4,
- Table_Increment => 100);
- -- The table for the presence of languages with an index that is outside
- -- of First_Language_Indexes.
+ type Header_Num is range 0 .. 2047;
- type Language_Kind is (GNU, other);
+ function Hash is new System.HTable.Hash (Header_Num => Header_Num);
+
+ function Hash (Name : Name_Id) return Header_Num;
+ function Hash (Name : File_Name_Type) return Header_Num;
+ function Hash (Name : Path_Name_Type) return Header_Num;
+
+ 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;
No_Name_List : constant Name_List_Index := 0;
Next : Name_List_Index := No_Name_List;
end record;
+ function Default_Language (In_Tree : Project_Tree_Ref) return Name_Id;
+
package Name_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Node,
Table_Index_Type => Name_List_Index,
Table_Increment => 100);
-- The table for lists of names used in package Language_Processing
- type Language_Processing_Data is record
- Compiler_Drivers : Name_List_Index := No_Name_List;
- Compiler_Paths : Name_Id := No_Name;
- Compiler_Kinds : Language_Kind := GNU;
- 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;
+ package Mapping_Files_Htable is new Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Path_Name_Type,
+ No_Element => No_Path,
+ Key => Path_Name_Type,
+ Hash => Hash,
+ Equal => "=");
+ -- A hash table to store the mapping files that are not used
- Default_Language_Processing_Data :
- constant Language_Processing_Data :=
- (Compiler_Drivers => No_Name_List,
- Compiler_Paths => No_Name,
- Compiler_Kinds => GNU,
- 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 Lang_Naming_Data is record
+ Dot_Replacement : File_Name_Type := No_File;
+ -- The string to replace '.' in the source file name (for Ada)
- type First_Language_Processing_Data is
- array (First_Language_Indexes) of Language_Processing_Data;
+ Casing : Casing_Type := All_Lower_Case;
+ -- The casing of the source file name (for Ada)
- Default_First_Language_Processing_Data :
- constant First_Language_Processing_Data :=
- (others => Default_Language_Processing_Data);
+ Separate_Suffix : File_Name_Type := No_File;
+ -- String to append to unit name for source file name of an Ada subunit
- 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;
+ 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;
- package Supp_Language_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Supp_Language_Data,
- Table_Index_Type => Supp_Language_Index,
+ No_Lang_Naming_Data : constant Lang_Naming_Data :=
+ (Dot_Replacement => No_File,
+ Casing => All_Lower_Case,
+ Separate_Suffix => No_File,
+ Spec_Suffix => No_File,
+ Body_Suffix => No_File);
+
+ type Source_Id is new Nat;
+
+ 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;
+
+ No_Language_Config : constant Language_Config :=
+ (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;
+
+ No_Language_Data : constant Language_Data :=
+ (Name => No_Name,
+ Display_Name => No_Name,
+ Config => No_Language_Config,
+ First_Source => No_Source,
+ Mapping_Files => Mapping_Files_Htable.Nil,
+ Next => No_Language_Index);
+
+ package Language_Data_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Language_Data,
+ Table_Index_Type => Language_Index,
Table_Low_Bound => 1,
- Table_Initial => 4,
+ Table_Initial => 10,
Table_Increment => 100);
- -- The table for language data when there are more languages than
- -- in First_Language_Indexes.
+ -- The table for lists of names used in package Language_Processing
- type Other_Source_Id is new Nat;
- No_Other_Source : constant Other_Source_Id := 0;
+ type Alternate_Language_Id is new Nat;
- type Other_Source is record
- Language : Language_Index; -- language of the source
- 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;
+ 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;
- -- 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,
+ package Alternate_Language_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Alternate_Language_Data,
+ Table_Index_Type => Alternate_Language_Id,
Table_Low_Bound => 1,
- Table_Initial => 200,
+ Table_Initial => 10,
Table_Increment => 100);
- -- The table for sources of languages other than Ada
+ -- The table for storing the alternate languages of a header file that
+ -- is used for several languages.
+
+ type Source_Kind is (Spec, Impl, Sep);
+
+ -- Following record needs full comments on every field ???
+
+ type Source_Data is record
+ Project : Project_Id := No_Project;
+ Language_Name : Name_Id := No_Name;
+ Language : Language_Index := No_Language_Index;
+ Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
+ Kind : Source_Kind := Spec;
+ Dependency : Dependency_File_Kind := Makefile;
+ Other_Part : Source_Id := No_Source;
+ Unit : Name_Id := No_Name;
+ Index : Int := 0;
+ 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 of multi-language stuff --
- ----------------------------------
+ No_Source_Data : constant Source_Data :=
+ (Project => No_Project,
+ 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_Initial => 1000,
+ Table_Increment => 100);
+ -- The table for the sources
+
+ package Source_Paths_Htable is new Simple_HTable
+ (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);
-- Verbosity when parsing GNAT Project Files
-- The current value of the verbosity the project files are parsed with
type Lib_Kind is (Static, Dynamic, Relocatable);
+
type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct);
-- Type to specify the symbol policy, when symbol control is supported.
-- See full explanation about this type in package Symbols.
-- Direct: The symbol file is used as is
type Symbol_Record is record
- Symbol_File : Name_Id := No_Name;
- Reference : Name_Id := No_Name;
+ Symbol_File : Path_Name_Type := No_Path;
+ Reference : Path_Name_Type := No_Path;
Symbol_Policy : Policy := Autonomous;
end record;
-- Type to keep the symbol data to be used when building a shared library
No_Symbols : constant Symbol_Record :=
- (Symbol_File => No_Name,
- Reference => No_Name,
+ (Symbol_File => No_Path,
+ Reference => No_Path,
Symbol_Policy => Autonomous);
-- The default value of the symbol data
- function Empty_String return Name_Id;
- -- Return the Name_Id for an empty string ""
+ function Image (Casing : Casing_Type) return String;
+ -- Similar to 'Image (but avoid use of this attribute in compiler)
- type Project_Id is new Nat;
- No_Project : constant Project_Id := 0;
- -- Id of a Project File
+ function Value (Image : String) return Casing_Type;
+ -- Similar to 'Value (but avoid use of this attribute in compiler)
+ -- Raises Constraint_Error if not a Casing_Type image.
- 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.
- -- The component Flag may be used for various purposes. For source
- -- directories, it indicates if the directory contains Ada source(s).
+ -- Declarations for gprmake:
- package String_Element_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => String_Element,
- Table_Index_Type => String_List_Id,
+ First_Language_Index : constant Language_Index := 1;
+ First_Language_Indexes_Last : constant Language_Index := 5;
+
+ Ada_Language_Index : constant Language_Index :=
+ 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;
+
+ Last_Language_Index : Language_Index := No_Language_Index;
+
+ subtype First_Language_Indexes is Language_Index
+ range First_Language_Index .. First_Language_Indexes_Last;
+
+ package Language_Indexes is new System.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Language_Index,
+ No_Element => No_Language_Index,
+ Key => Name_Id,
+ Hash => Hash,
+ Equal => "=");
+ -- Mapping of language names to language indexes
+
+ package Language_Names is new Table.Table
+ (Table_Component_Type => Name_Id,
+ Table_Index_Type => Language_Index,
Table_Low_Bound => 1,
- Table_Initial => 200,
- Table_Increment => 100);
- -- The table for string elements in string lists
+ Table_Initial => 4,
+ Table_Increment => 100,
+ Table_Name => "Prj.Language_Names");
+ -- The table for the name of programming languages
- type Variable_Kind is (Undefined, List, Single);
- -- Different kinds of variables
+ procedure Add_Language_Name (Name : Name_Id);
- subtype Defined_Variable_Kind is Variable_Kind range List .. Single;
- -- The defined kinds of variables
+ procedure Display_Language_Name (Language : Language_Index);
- Ignored : constant Variable_Kind;
- -- Used to indicate that a package declaration must be ignored
- -- while processing the project tree (unknown package name).
+ type Languages_In_Project is array (First_Language_Indexes) of Boolean;
+ -- Set of supported languages used in a project
- type Variable_Value (Kind : Variable_Kind := Undefined) is record
- 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
+ No_Languages : constant Languages_In_Project := (others => False);
+ -- No supported languages are used
- Nil_Variable_Value : constant Variable_Value;
- -- Value of a non existing variable or array element
+ type Supp_Language_Index is new Nat;
+ No_Supp_Language_Index : constant Supp_Language_Index := 0;
- 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;
+ type Supp_Language is record
+ Index : Language_Index := No_Language_Index;
+ Present : Boolean := False;
+ Next : Supp_Language_Index := No_Supp_Language_Index;
end record;
- -- To hold the list of variables in a project file and in packages
- package Variable_Element_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Variable,
- Table_Index_Type => Variable_Id,
+ package Present_Language_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Supp_Language,
+ Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1,
- Table_Initial => 200,
+ Table_Initial => 4,
Table_Increment => 100);
- -- The table of variable in list of variables
+ -- The table for the presence of languages with an index that is outside
+ -- of First_Language_Indexes.
- type Array_Element_Id is new Nat;
- No_Array_Element : constant Array_Element_Id := 0;
- type Array_Element is record
- Index : Name_Id;
- Src_Index : Int := 0;
- Index_Case_Sensitive : Boolean := True;
- Value : Variable_Value;
- 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.
+ type Impl_Suffix_Array is array (First_Language_Indexes) of File_Name_Type;
+ -- Suffixes for the non spec sources of the different supported languages
+ -- in a project.
- package Array_Element_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Array_Element,
- Table_Index_Type => Array_Element_Id,
- Table_Low_Bound => 1,
- Table_Initial => 200,
- Table_Increment => 100);
- -- The table that contains all array elements
+ No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_File);
+ -- A default value for the non spec source suffixes
- 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;
+ 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;
- -- 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
- (Table_Component_Type => Array_Data,
- Table_Index_Type => Array_Id,
+ package Supp_Suffix_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Supp_Suffix,
+ Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1,
- Table_Initial => 200,
+ Table_Initial => 4,
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;
- 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;
+ type Lang_Kind is (GNU, Other);
+
+ type Language_Processing_Data is record
+ Compiler_Drivers : Name_List_Index := No_Name_List;
+ Compiler_Paths : Name_Id := No_Name;
+ Compiler_Kinds : Lang_Kind := GNU;
+ 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;
- -- Contains the declarations (variables, single and array attributes,
- -- packages) for a project or a package in a project.
- No_Declarations : constant Declarations :=
- (Variables => No_Variable,
- Attributes => No_Variable,
- Arrays => No_Array,
- Packages => No_Package);
- -- Default value of Declarations: indicates that there is no declarations
+ Default_Language_Processing_Data :
+ constant Language_Processing_Data :=
+ (Compiler_Drivers => No_Name_List,
+ Compiler_Paths => No_Name,
+ Compiler_Kinds => GNU,
+ 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
- Name : Name_Id := No_Name;
- Decl : Declarations := No_Declarations;
- Parent : Package_Id := No_Package;
- Next : Package_Id := No_Package;
+ type First_Language_Processing_Data is
+ array (First_Language_Indexes) of Language_Processing_Data;
+
+ Default_First_Language_Processing_Data :
+ constant First_Language_Processing_Data :=
+ (others => Default_Language_Processing_Data);
+
+ type Supp_Language_Data is record
+ Index : Language_Index := No_Language_Index;
+ Data : Language_Processing_Data := Default_Language_Processing_Data;
+ Next : Supp_Language_Index := No_Supp_Language_Index;
end record;
- -- A package (includes declarations that may include other packages)
- package Package_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Package_Element,
- Table_Index_Type => Package_Id,
+ package Supp_Language_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Supp_Language_Data,
+ Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1,
- Table_Initial => 100,
+ Table_Initial => 4,
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;
- -- Similar to 'Image (but avoid use of this attribute in compiler)
+ type Other_Source_Id is new Nat;
+ No_Other_Source : constant Other_Source_Id := 0;
- function Value (Image : String) return Casing_Type;
- -- Similar to 'Value (but avoid use of this attribute in compiler)
- -- Raises Constraint_Error if not a Casing_Type image.
+ type Other_Source is record
+ Language : Language_Index; -- language of the source
+ 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 string to replace '.' in the source file name (for Ada)
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;
-- The casing of the source file name (for Ada)
-- source file name of a spec.
-- Indexed by the programming language.
- Ada_Spec_Suffix : File_Name_Type := No_File;
- -- 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
+ Ada_Spec_Suffix_Loc : Source_Ptr := No_Location;
Body_Suffix : Array_Element_Id := No_Array_Element;
-- The string to append to the unit name for the
-- source file name of a body.
-- Indexed by the programming language.
- Ada_Body_Suffix : File_Name_Type := No_File;
- -- 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.
+ Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
Separate_Suffix : File_Name_Type := No_File;
-- String to append to unit name for source file name of an Ada subunit
-- An associative array listing body file names that do not have the
-- 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;
+ 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
(Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data;
pragma Inline (Standard_Naming_Data);
Table_Increment => 100);
-- 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
type Project_Data is record
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;
- Supp_Languages : Supp_Language_Index := No_Supp_Language_Index;
- -- Indicate the different languages of the source of this project
+ Languages : Name_List_Index := No_Name_List;
+ -- The list of languages of the sources of this project
+
+ Config : Project_Configuration;
First_Referred_By : Project_Id := No_Project;
-- 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;
- -- The name of the project. Set by Prj.Proc.Process
+ -- The name of the project
Display_Name : Name_Id := No_Name;
- -- The name of the project with the spelling of its declaration.
- -- Set by Prj.Proc.Process.
+ -- The name of the project with the spelling of its declaration
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;
-- The path name used for display purposes. May be different from
-- True for virtual extending projects
Location : Source_Ptr := No_Location;
- -- The location in the project file source of the reserved word
- -- project. Set by Prj.Proc.Process.
+ -- The location in the project file source of the reserved word project
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 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;
- -- Project directory path name for display purposes. May be different
- -- from Directory for platforms where file names are case-insensitive.
+ -- The path name of the project directory, for display purposes. May be
+ -- different from Directory for platforms where the file names are
+ -- case-insensitive.
Dir_Path : String_Access;
- -- Same as Directory, but as an access to String. Set by
- -- Make.Compile_Sources.Collect_Arguments_And_Compile.
+ -- Same as Directory, but as an access to String
Library : Boolean := False;
- -- True if this is a library project. Set by
- -- Prj.Nmsc.Language_Independent_Check.
+ -- True if this is a library project
Library_Dir : Path_Name_Type := No_Path;
- -- If a library project, directory where the library Set by
- -- Prj.Nmsc.Language_Independent_Check.
+ -- If a library project, path name of the directory where the library
+ -- resides.
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
-- case-insensitive.
Library_TS : Time_Stamp_Type := Empty_Time_Stamp;
- -- The timestamp of a library file in a library project.
- -- Set by MLib.Prj.Check_Library.
+ -- The timestamp of a library file in a library project
Library_Src_Dir : Path_Name_Type := No_Path;
- -- If a Stand-Alone Library project, directory where the sources
- -- of the interfaces of the library are copied. By default, if
- -- attribute Library_Src_Dir is not specified, sources of the interfaces
- -- are not copied anywhere. Set by Prj.Nmsc.Check_Stand_Alone_Library.
+ -- If a Stand-Alone Library project, path name of the directory where
+ -- the sources of the interfaces of the library are copied. By default,
+ -- if attribute Library_Src_Dir is not specified, sources of the
+ -- interfaces are not copied anywhere.
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
-- names are case-insensitive.
Library_ALI_Dir : Path_Name_Type := No_Path;
- -- In a library project, directory where the ALI files are copied.
- -- If attribute Library_ALI_Dir is not specified, ALI files are
- -- copied in the Library_Dir. Set by Prj.Nmsc.Check_Library_Attributes.
+ -- In a library project, path name of the directory where the ALI files
+ -- are copied. If attribute Library_ALI_Dir is not specified, ALI files
+ -- are copied in the Library_Dir.
Display_Library_ALI_Dir : Path_Name_Type := No_Path;
- -- The name of the library ALI directory, for display purposes. May be
- -- different from Library_ALI_Dir for platforms where the file names are
- -- case-insensitive.
+ -- The path name of the library ALI directory, for display purposes. May
+ -- be different from Library_ALI_Dir for platforms where the file names
+ -- are case-insensitive.
- Library_Name : File_Name_Type := No_File;
+ Library_Name : Name_Id := No_Name;
-- If a library project, name of the library
- -- Set by Prj.Nmsc.Language_Independent_Check.
Library_Kind : Lib_Kind := Static;
-- If a library project, kind of library
- -- Set by Prj.Nmsc.Language_Independent_Check.
- Lib_Internal_Name : File_Name_Type := No_File;
- -- If a library project, internal name store inside the library Set by
- -- Prj.Nmsc.Language_Independent_Check.
+ Lib_Internal_Name : Name_Id := No_Name;
+ -- If a library project, internal name store inside the library
Standalone_Library : Boolean := False;
- -- Indicate that this is a Standalone Library Project File. Set by
- -- Prj.Nmsc.Check.
+ -- Indicate that this is a Standalone Library Project File
Lib_Interface_ALIs : String_List_Id := Nil_String;
-- For Standalone Library Project Files, indicate the list of Interface
- -- ALI files. Set by Prj.Nmsc.Check.
+ -- ALI files.
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.
Libgnarl_Needed : Yes_No_Unknown := Unknown;
Symbol_Data : Symbol_Record := No_Symbols;
-- Symbol file name, reference symbol file name, symbol policy
- Ada_Sources_Present : Boolean := True;
- -- A flag that indicates if there are Ada sources in this project file.
- -- 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
+ Ada_Sources : String_List_Id := Nil_String;
+ -- The list of all the Ada source file names (gnatmake only).
- Other_Sources_Present : Boolean := True;
- -- A flag that indicates that there are non-Ada sources in this project
+ Sources : String_List_Id := Nil_String;
+ -- Identical to Ada_Sources. For upward compatibility of GPS.
- Sources : String_List_Id := Nil_String;
- -- The list of all the source file names.
- -- Set by Prj.Nmsc.Check_Ada_Naming_Scheme.
+ First_Source : Source_Id := No_Source;
+ Last_Source : Source_Id := No_Source;
+ -- Head and tail of the list of sources
- First_Other_Source : Other_Source_Id := No_Other_Source;
- Last_Other_Source : Other_Source_Id := No_Other_Source;
- -- Head and tail of the list of sources of languages other than Ada
+ 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;
- -- List of the -I switches to be used when compiling sources of
- -- languages other than Ada.
+ -- List of the source search switches (-I<source dir>) to be used when
+ -- compiling.
Include_Path : String_Access := null;
- -- Value to be used as CPATH, when using a GCC, instead of a list of
- -- -I switches.
+ -- Value of the environment variable to indicate the source search path,
+ -- 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;
-- 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;
- -- The list of all the source directories.
- -- Set by Prj.Nmsc.Language_Independent_Check.
+ -- The list of all the source directories
Known_Order_Of_Source_Dirs : Boolean := True;
-- False, if there is any /** in the Source_Dirs, because in this case
-- duplicate file names in the same project file are allowed.
Object_Directory : Path_Name_Type := No_Path;
- -- The object directory of this project file.
- -- Set by Prj.Nmsc.Language_Independent_Check.
+ -- The path name of the object directory of this project file
Display_Object_Dir : Path_Name_Type := No_Path;
- -- The name of the object directory, for display purposes.
- -- May be different from Object_Directory for platforms where the file
- -- names are case-insensitive.
+ -- The path name of the object directory, for display purposes. May be
+ -- different from Object_Directory for platforms where the file names
+ -- are case-insensitive.
Exec_Directory : Path_Name_Type := No_Path;
- -- The exec directory of this project file. Default is equal to
- -- Object_Directory. Set by Prj.Nmsc.Language_Independent_Check.
+ -- The path name of the exec directory of this project file. Default is
+ -- equal to Object_Directory.
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
-- case-insensitive.
Extends : Project_Id := No_Project;
-- 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;
-- 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;
- -- The naming scheme of this project file.
- -- Set by Prj.Nmsc.Check_Naming_Scheme.
+ -- The naming scheme of this project file
- First_Language_Processing : First_Language_Processing_Data :=
- Default_First_Language_Processing_Data;
+ First_Language_Processing : Language_Index := No_Language_Index;
-- 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;
- -- The declarations (variables, attributes and packages) of this
- -- project file. Set by Prj.Proc.Process.
+ -- The declarations (variables, attributes and packages) of this project
+ -- file.
Imported_Projects : Project_List := Empty_Project_List;
- -- The list of all directly imported projects, if any. Set by
- -- Prj.Proc.Process.
+ -- The list of all directly imported projects, if any
All_Imported_Projects : Project_List := Empty_Project_List;
- -- The list of all projects imported directly or indirectly, if any.
- -- Set by Make.Initialize.
+ -- The list of all projects imported directly or indirectly, if any
Ada_Include_Path : String_Access := null;
-- The cached value of ADA_INCLUDE_PATH for this project file. Do not
-- 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;
-- The cached value of ADA_OBJECTS_PATH for this project file. Do not
-- 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;
- -- The cached value of the source path temp file for this project file.
- -- Set by gnatmake (Prj.Env.Set_Ada_Paths).
+ Objects_Path : String_Access := null;
+ -- ???
Objects_Path_File_With_Libs : Path_Name_Type := No_Path;
-- 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;
-- 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;
- -- The name of the configuration pragmas file, if any.
- -- Set by gnatmake (Prj.Env.Create_Config_Pragmas_File).
+ -- The path name of the configuration pragmas file, if any
Config_File_Temp : Boolean := False;
- -- An indication that the configuration pragmas file is
- -- a temporary file that must be deleted at the end.
- -- Set by gnatmake (Prj.Env.Create_Config_Pragmas_File).
+ -- An indication that the configuration pragmas file is a temporary file
+ -- that must be deleted at the end.
- Config_Checked : Boolean := False;
- -- A flag to avoid checking repetitively the configuration pragmas file.
- -- Set by gnatmake (Prj.Env.Create_Config_Pragmas_File).
+ Linker_Name : File_Name_Type := No_File;
+ -- Value of attribute Language_Processing'Linker in the project file
+
+ Linker_Path : Path_Name_Type := No_Path;
+ -- Path of linker when attribute Language_Processing'Linker is specified
+
+ Minimum_Linker_Options : Name_List_Index := No_Name_List;
+ -- List of options specified in attribute
+ -- Language_Processing'Minimum_Linker_Options.
- Language_Independent_Checked : Boolean := False;
- -- A flag that indicates that the project file has been checked
- -- for language independent features: Object_Directory,
- -- Source_Directories, Library, non empty Naming Suffixes.
+ Config_Checked : Boolean := False;
+ -- A flag to avoid checking repetitively the configuration pragmas file
Checked : Boolean := False;
- -- A flag to avoid checking repetitively the naming scheme of
- -- this project file. Set by Prj.Nmsc.Check_Ada_Naming_Scheme.
+ -- A flag to avoid checking repetitively the naming scheme of this
+ -- project file.
Seen : Boolean := False;
-- A flag to mark a project as "visited" to avoid processing the same
-- rebuilt.
Depth : Natural := 0;
- -- The maximum depth of a project in the project graph.
- -- Depth of main project is 0.
+ -- The maximum depth of a project in the project graph. Depth of main
+ -- project is 0.
Unkept_Comments : Boolean := False;
- -- True if there are comments in the project sources that cannot
- -- be kept in the project tree.
+ -- True if there are comments in the project sources that cannot be kept
+ -- 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;
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
-- Return the representation of an empty project in project Tree tree.
-- The project tree Tree must have been Initialized and/or Reset.
+ 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;
-- Raised by some subprograms in Prj.Attr
type File_Name_Data is record
Name : File_Name_Type := No_File;
- Index : Int := 0;
+ Index : Int := 0;
Display_Name : File_Name_Type := No_File;
- Path : File_Name_Type := No_File;
- Display_Path : File_Name_Type := No_File;
- Project : Project_Id := No_Project;
- Needs_Pragma : Boolean := False;
+ Path : Path_Name_Type := No_Path;
+ Display_Path : Path_Name_Type := No_Path;
+ Project : Project_Id := No_Project;
+ Needs_Pragma : Boolean := False;
end record;
-- File and Path name of a spec or body
type File_Names_Data is array (Spec_Or_Body) of File_Name_Data;
- type Unit_Id is new Nat;
- No_Unit : constant Unit_Id := 0;
+ type Unit_Index is new Nat;
+ No_Unit_Index : constant Unit_Index := 0;
type Unit_Data is record
Name : Name_Id := No_Name;
File_Names : File_Names_Data;
package Unit_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Unit_Data,
- Table_Index_Type => Unit_Id,
+ Table_Index_Type => Unit_Index,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100);
package Units_Htable is new Simple_HTable
(Header_Num => Header_Num,
- Element => Unit_Id,
- No_Element => No_Unit,
+ Element => Unit_Index,
+ No_Element => No_Unit_Index,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Mapping of unit names to indexes in the Units table
type Unit_Project is record
- Unit : Unit_Id := No_Unit;
+ Unit : Unit_Index := No_Unit_Index;
Project : Project_Id := No_Project;
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
(Header_Num => Header_Num,
type Project_Tree_Data is
record
+ -- General
+
+ 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;
+ String_Elements : String_Element_Table.Instance;
+ Variable_Elements : Variable_Element_Table.Instance;
+ Array_Elements : Array_Element_Table.Instance;
+ Arrays : Array_Table.Instance;
+ Packages : Package_Table.Instance;
+ Project_Lists : Project_List_Table.Instance;
+ Projects : Project_Table.Instance;
+ Sources : Source_Data_Table.Instance;
+ Alt_Langs : Alternate_Language_Table.Instance;
+ Units : Unit_Table.Instance;
+ Units_HT : Units_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;
- Name_Lists : Name_List_Table.Instance;
Supp_Languages : Supp_Language_Table.Instance;
Other_Sources : Other_Source_Table.Instance;
- String_Elements : String_Element_Table.Instance;
- Variable_Elements : Variable_Element_Table.Instance;
- Array_Elements : Array_Element_Table.Instance;
- Arrays : Array_Table.Instance;
- Packages : Package_Table.Instance;
- Project_Lists : Project_List_Table.Instance;
- Projects : Project_Table.Instance;
- Units : Unit_Table.Instance;
- Units_HT : Units_Htable.Instance;
- Files_HT : Files_Htable.Instance;
- Private_Part : Private_Project_Tree_Data;
+
+ -- Private part
+
+ Private_Part : Private_Project_Tree_Data;
end record;
-- Data for a project tree
-- that are extended by other projects are not considered. With_State may
-- be used by Action to choose a behavior or to report some global result.
- ----------------------------------------------------------
- -- Other multi-language stuff that may be modified soon --
- ----------------------------------------------------------
+ function Extend_Name
+ (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
(Language : Language_Index;
In_Tree : Project_Tree_Ref);
-- 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
All_Packages : constant String_List_Access := null;
-- Used by Delete_All_Path_Files.
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_Low_Bound => 1,
Table_Initial => 50,
Object_Paths : Object_Path_Table.Instance;
Default_Naming : Naming_Data;
end record;
- -- Comment ???
+ -- Type to represent the part of a project tree which is private to the
+ -- Project Manager.
+
end Prj;
with Opt; use Opt;
with Table;
+with Types; use Types;
package body Snames is
"ada_2005#" &
"assertion_policy#" &
"c_pass_by_copy#" &
+ "check_name#" &
"compile_time_error#" &
"compile_time_warning#" &
"component_alignment#" &
"extensions_allowed#" &
"external_name_casing#" &
"float_representation#" &
+ "implicit_packing#" &
"initialize_scalars#" &
"interrupt_state#" &
"license#" &
"digits#" &
"elaborated#" &
"emax#" &
+ "enabled#" &
"enum_rep#" &
"epsilon#" &
"exponent#" &
"archive_indexer#" &
"archive_suffix#" &
"binder#" &
- "binder_driver#" &
"binder_prefix#" &
"body_suffix#" &
"builder#" &
"builder_switches#" &
"compiler#" &
- "compiler_driver#" &
"compiler_kind#" &
- "compiler_pic_option#" &
- "compute_dependency#" &
"config_body_file_name#" &
"config_body_file_name_pattern#" &
"config_file_switches#" &
"config_spec_file_name#" &
"config_spec_file_name_pattern#" &
"cross_reference#" &
- "default_builder_switches#" &
- "default_global_compiler_switches#" &
"default_language#" &
- "default_linker#" &
- "default_minimum_linker_options#" &
"default_switches#" &
+ "dependency_driver#" &
"dependency_file_kind#" &
- "dependency_option#" &
+ "dependency_switches#" &
+ "driver#" &
"exec_dir#" &
"executable#" &
"executable_suffix#" &
"extends#" &
"externally_built#" &
"finder#" &
- "global_compiler_switches#" &
"global_configuration_pragmas#" &
"global_config_file#" &
"gnatls#" &
"library_symbol_file#" &
"library_symbol_policy#" &
"library_version#" &
- "library_version_options#" &
+ "library_version_switches#" &
"linker#" &
"linker_executable_option#" &
"linker_lib_dir_option#" &
"mapping_spec_suffix#" &
"mapping_body_suffix#" &
"metrics#" &
- "minimum_binder_options#" &
- "minimum_compiler_options#" &
- "minimum_linker_options#" &
"naming#" &
"objects_path#" &
"objects_path_file#" &
"object_dir#" &
+ "pic_option#" &
"pretty_printer#" &
+ "prefix#" &
"project#" &
"roots#" &
+ "required_switches#" &
"run_path_option#" &
"runtime_project#" &
- "shared_library_minimum_options#" &
+ "shared_library_minimum_switches#" &
"shared_library_prefix#" &
"shared_library_suffix#" &
"separate_suffix#" &
return Attribute_Id'Val (N - First_Attribute_Name);
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 --
-----------------------
return N in First_Attribute_Name .. Last_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 --
------------------------
------------------------------------------------------------------------------
with Namet; use Namet;
-with Types; use Types;
package Snames is
Name_Ada_2005 : constant Name_Id := N + 119; -- GNAT
Name_Assertion_Policy : constant Name_Id := N + 120; -- Ada 05
Name_C_Pass_By_Copy : constant Name_Id := N + 121; -- GNAT
- Name_Compile_Time_Error : constant Name_Id := N + 122; -- GNAT
- Name_Compile_Time_Warning : constant Name_Id := N + 123; -- GNAT
- Name_Component_Alignment : constant Name_Id := N + 124; -- GNAT
- Name_Convention_Identifier : constant Name_Id := N + 125; -- GNAT
- Name_Debug_Policy : constant Name_Id := N + 126; -- GNAT
- Name_Detect_Blocking : constant Name_Id := N + 127; -- Ada 05
- Name_Discard_Names : constant Name_Id := N + 128;
- Name_Elaboration_Checks : constant Name_Id := N + 129; -- GNAT
- Name_Eliminate : constant Name_Id := N + 130; -- GNAT
- Name_Extend_System : constant Name_Id := N + 131; -- GNAT
- Name_Extensions_Allowed : constant Name_Id := N + 132; -- GNAT
- Name_External_Name_Casing : constant Name_Id := N + 133; -- GNAT
- Name_Float_Representation : constant Name_Id := N + 134; -- GNAT
- Name_Initialize_Scalars : constant Name_Id := N + 135; -- GNAT
- Name_Interrupt_State : constant Name_Id := N + 136; -- GNAT
- Name_License : constant Name_Id := N + 137; -- GNAT
- Name_Locking_Policy : constant Name_Id := N + 138;
- Name_Long_Float : constant Name_Id := N + 139; -- VMS
- Name_No_Run_Time : constant Name_Id := N + 140; -- GNAT
- Name_No_Strict_Aliasing : constant Name_Id := N + 141; -- GNAT
- Name_Normalize_Scalars : constant Name_Id := N + 142;
- Name_Polling : constant Name_Id := N + 143; -- GNAT
- Name_Persistent_BSS : constant Name_Id := N + 144; -- GNAT
- Name_Priority_Specific_Dispatching : constant Name_Id := N + 145; -- Ada 05
- Name_Profile : constant Name_Id := N + 146; -- Ada 05
- Name_Profile_Warnings : constant Name_Id := N + 147; -- GNAT
- Name_Propagate_Exceptions : constant Name_Id := N + 148; -- GNAT
- Name_Queuing_Policy : constant Name_Id := N + 149;
- Name_Ravenscar : constant Name_Id := N + 150; -- GNAT
- Name_Restricted_Run_Time : constant Name_Id := N + 151; -- GNAT
- Name_Restrictions : constant Name_Id := N + 152;
- Name_Restriction_Warnings : constant Name_Id := N + 153; -- GNAT
- Name_Reviewable : constant Name_Id := N + 154;
- Name_Source_File_Name : constant Name_Id := N + 155; -- GNAT
- Name_Source_File_Name_Project : constant Name_Id := N + 156; -- GNAT
- Name_Style_Checks : constant Name_Id := N + 157; -- GNAT
- Name_Suppress : constant Name_Id := N + 158;
- Name_Suppress_Exception_Locations : constant Name_Id := N + 159; -- GNAT
- Name_Task_Dispatching_Policy : constant Name_Id := N + 160;
- Name_Universal_Data : constant Name_Id := N + 161; -- AAMP
- Name_Unsuppress : constant Name_Id := N + 162; -- GNAT
- Name_Use_VADS_Size : constant Name_Id := N + 163; -- GNAT
- Name_Validity_Checks : constant Name_Id := N + 164; -- GNAT
- Name_Warnings : constant Name_Id := N + 165; -- GNAT
- Name_Wide_Character_Encoding : constant Name_Id := N + 166; -- GNAT
- Last_Configuration_Pragma_Name : constant Name_Id := N + 166;
+ Name_Check_Name : constant Name_Id := N + 122; -- GNAT
+ Name_Compile_Time_Error : constant Name_Id := N + 123; -- GNAT
+ Name_Compile_Time_Warning : constant Name_Id := N + 124; -- GNAT
+ Name_Component_Alignment : constant Name_Id := N + 125; -- GNAT
+ Name_Convention_Identifier : constant Name_Id := N + 126; -- GNAT
+ Name_Debug_Policy : constant Name_Id := N + 127; -- GNAT
+ Name_Detect_Blocking : constant Name_Id := N + 128; -- Ada 05
+ Name_Discard_Names : constant Name_Id := N + 129;
+ Name_Elaboration_Checks : constant Name_Id := N + 130; -- GNAT
+ Name_Eliminate : constant Name_Id := N + 131; -- GNAT
+ Name_Extend_System : constant Name_Id := N + 132; -- GNAT
+ Name_Extensions_Allowed : constant Name_Id := N + 133; -- GNAT
+ Name_External_Name_Casing : constant Name_Id := N + 134; -- GNAT
+ Name_Float_Representation : constant Name_Id := N + 135; -- GNAT
+ Name_Implicit_Packing : constant Name_Id := N + 136; -- GNAT
+ Name_Initialize_Scalars : constant Name_Id := N + 137; -- GNAT
+ Name_Interrupt_State : constant Name_Id := N + 138; -- GNAT
+ Name_License : constant Name_Id := N + 139; -- GNAT
+ Name_Locking_Policy : constant Name_Id := N + 140;
+ Name_Long_Float : constant Name_Id := N + 141; -- VMS
+ Name_No_Run_Time : constant Name_Id := N + 142; -- GNAT
+ Name_No_Strict_Aliasing : constant Name_Id := N + 143; -- GNAT
+ Name_Normalize_Scalars : constant Name_Id := N + 144;
+ Name_Polling : constant Name_Id := N + 145; -- GNAT
+ Name_Persistent_BSS : constant Name_Id := N + 146; -- GNAT
+ Name_Priority_Specific_Dispatching : constant Name_Id := N + 147; -- Ada 05
+ Name_Profile : constant Name_Id := N + 148; -- Ada 05
+ Name_Profile_Warnings : constant Name_Id := N + 149; -- GNAT
+ Name_Propagate_Exceptions : constant Name_Id := N + 150; -- GNAT
+ Name_Queuing_Policy : constant Name_Id := N + 151;
+ Name_Ravenscar : constant Name_Id := N + 152; -- GNAT
+ Name_Restricted_Run_Time : constant Name_Id := N + 153; -- GNAT
+ Name_Restrictions : constant Name_Id := N + 154;
+ Name_Restriction_Warnings : constant Name_Id := N + 155; -- GNAT
+ Name_Reviewable : constant Name_Id := N + 156;
+ Name_Source_File_Name : constant Name_Id := N + 157; -- GNAT
+ Name_Source_File_Name_Project : constant Name_Id := N + 158; -- GNAT
+ Name_Style_Checks : constant Name_Id := N + 159; -- GNAT
+ Name_Suppress : constant Name_Id := N + 160;
+ Name_Suppress_Exception_Locations : constant Name_Id := N + 161; -- GNAT
+ Name_Task_Dispatching_Policy : constant Name_Id := N + 162;
+ Name_Universal_Data : constant Name_Id := N + 163; -- AAMP
+ Name_Unsuppress : constant Name_Id := N + 164; -- GNAT
+ Name_Use_VADS_Size : constant Name_Id := N + 165; -- GNAT
+ Name_Validity_Checks : constant Name_Id := N + 166; -- GNAT
+ 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
- Name_Abort_Defer : constant Name_Id := N + 167; -- GNAT
- Name_All_Calls_Remote : constant Name_Id := N + 168;
- Name_Annotate : constant Name_Id := N + 169; -- GNAT
+ Name_Abort_Defer : constant Name_Id := N + 169; -- GNAT
+ Name_All_Calls_Remote : constant Name_Id := N + 170;
+ Name_Annotate : constant Name_Id := N + 171; -- GNAT
-- Note: AST_Entry is not in this list because its name matches the
-- name of the corresponding attribute. However, it is included in the
-- and Check_Pragma_Id correctly recognize and process Name_AST_Entry.
-- AST_Entry is a VMS specific pragma.
- Name_Assert : constant Name_Id := N + 170; -- Ada 05
- Name_Asynchronous : constant Name_Id := N + 171;
- Name_Atomic : constant Name_Id := N + 172;
- Name_Atomic_Components : constant Name_Id := N + 173;
- Name_Attach_Handler : constant Name_Id := N + 174;
- Name_CIL_Constructor : constant Name_Id := N + 175; -- GNAT
- Name_Comment : constant Name_Id := N + 176; -- GNAT
- Name_Common_Object : constant Name_Id := N + 177; -- GNAT
- Name_Complete_Representation : constant Name_Id := N + 178; -- GNAT
- Name_Complex_Representation : constant Name_Id := N + 179; -- GNAT
- Name_Controlled : constant Name_Id := N + 180;
- Name_Convention : constant Name_Id := N + 181;
- Name_CPP_Class : constant Name_Id := N + 182; -- GNAT
- Name_CPP_Constructor : constant Name_Id := N + 183; -- GNAT
- Name_CPP_Virtual : constant Name_Id := N + 184; -- GNAT
- Name_CPP_Vtable : constant Name_Id := N + 185; -- GNAT
- Name_Debug : constant Name_Id := N + 186; -- GNAT
- Name_Elaborate : constant Name_Id := N + 187; -- Ada 83
- Name_Elaborate_All : constant Name_Id := N + 188;
- Name_Elaborate_Body : constant Name_Id := N + 189;
- Name_Export : constant Name_Id := N + 190;
- Name_Export_Exception : constant Name_Id := N + 191; -- VMS
- Name_Export_Function : constant Name_Id := N + 192; -- GNAT
- Name_Export_Object : constant Name_Id := N + 193; -- GNAT
- Name_Export_Procedure : constant Name_Id := N + 194; -- GNAT
- Name_Export_Value : constant Name_Id := N + 195; -- GNAT
- Name_Export_Valued_Procedure : constant Name_Id := N + 196; -- GNAT
- Name_External : constant Name_Id := N + 197; -- GNAT
- Name_Finalize_Storage_Only : constant Name_Id := N + 198; -- GNAT
- Name_Ident : constant Name_Id := N + 199; -- VMS
- Name_Import : constant Name_Id := N + 200;
- Name_Import_Exception : constant Name_Id := N + 201; -- VMS
- Name_Import_Function : constant Name_Id := N + 202; -- GNAT
- Name_Import_Object : constant Name_Id := N + 203; -- GNAT
- Name_Import_Procedure : constant Name_Id := N + 204; -- GNAT
- Name_Import_Valued_Procedure : constant Name_Id := N + 205; -- GNAT
- Name_Inline : constant Name_Id := N + 206;
- Name_Inline_Always : constant Name_Id := N + 207; -- GNAT
- Name_Inline_Generic : constant Name_Id := N + 208; -- GNAT
- Name_Inspection_Point : constant Name_Id := N + 209;
- Name_Interface_Name : constant Name_Id := N + 210; -- GNAT
- Name_Interrupt_Handler : constant Name_Id := N + 211;
- Name_Interrupt_Priority : constant Name_Id := N + 212;
- Name_Java_Constructor : constant Name_Id := N + 213; -- GNAT
- Name_Java_Interface : constant Name_Id := N + 214; -- GNAT
- Name_Keep_Names : constant Name_Id := N + 215; -- GNAT
- Name_Link_With : constant Name_Id := N + 216; -- GNAT
- Name_Linker_Alias : constant Name_Id := N + 217; -- GNAT
- Name_Linker_Constructor : constant Name_Id := N + 218; -- GNAT
- Name_Linker_Destructor : constant Name_Id := N + 219; -- GNAT
- Name_Linker_Options : constant Name_Id := N + 220;
- Name_Linker_Section : constant Name_Id := N + 221; -- GNAT
- Name_List : constant Name_Id := N + 222;
- Name_Machine_Attribute : constant Name_Id := N + 223; -- GNAT
- Name_Main : constant Name_Id := N + 224; -- GNAT
- Name_Main_Storage : constant Name_Id := N + 225; -- GNAT
- Name_Memory_Size : constant Name_Id := N + 226; -- Ada 83
- Name_No_Body : constant Name_Id := N + 227; -- GNAT
- Name_No_Return : constant Name_Id := N + 228; -- GNAT
- Name_Obsolescent : constant Name_Id := N + 229; -- GNAT
- Name_Optimize : constant Name_Id := N + 230;
- Name_Pack : constant Name_Id := N + 231;
- Name_Page : constant Name_Id := N + 232;
- Name_Passive : constant Name_Id := N + 233; -- GNAT
- Name_Preelaborable_Initialization : constant Name_Id := N + 234; -- Ada 05
- Name_Preelaborate : constant Name_Id := N + 235;
- Name_Preelaborate_05 : constant Name_Id := N + 236; -- GNAT
+ Name_Assert : constant Name_Id := N + 172; -- Ada 05
+ Name_Asynchronous : constant Name_Id := N + 173;
+ Name_Atomic : constant Name_Id := N + 174;
+ Name_Atomic_Components : constant Name_Id := N + 175;
+ Name_Attach_Handler : constant Name_Id := N + 176;
+ Name_CIL_Constructor : constant Name_Id := N + 177; -- GNAT
+ Name_Comment : constant Name_Id := N + 178; -- GNAT
+ Name_Common_Object : constant Name_Id := N + 179; -- GNAT
+ Name_Complete_Representation : constant Name_Id := N + 180; -- GNAT
+ Name_Complex_Representation : constant Name_Id := N + 181; -- GNAT
+ Name_Controlled : constant Name_Id := N + 182;
+ Name_Convention : constant Name_Id := N + 183;
+ Name_CPP_Class : constant Name_Id := N + 184; -- GNAT
+ Name_CPP_Constructor : constant Name_Id := N + 185; -- GNAT
+ Name_CPP_Virtual : constant Name_Id := N + 186; -- GNAT
+ Name_CPP_Vtable : constant Name_Id := N + 187; -- GNAT
+ Name_Debug : constant Name_Id := N + 188; -- GNAT
+ Name_Elaborate : constant Name_Id := N + 189; -- Ada 83
+ Name_Elaborate_All : constant Name_Id := N + 190;
+ Name_Elaborate_Body : constant Name_Id := N + 191;
+ Name_Export : constant Name_Id := N + 192;
+ Name_Export_Exception : constant Name_Id := N + 193; -- VMS
+ Name_Export_Function : constant Name_Id := N + 194; -- GNAT
+ Name_Export_Object : constant Name_Id := N + 195; -- GNAT
+ Name_Export_Procedure : constant Name_Id := N + 196; -- GNAT
+ Name_Export_Value : constant Name_Id := N + 197; -- GNAT
+ Name_Export_Valued_Procedure : constant Name_Id := N + 198; -- GNAT
+ Name_External : constant Name_Id := N + 199; -- GNAT
+ Name_Finalize_Storage_Only : constant Name_Id := N + 200; -- GNAT
+ Name_Ident : constant Name_Id := N + 201; -- VMS
+ Name_Import : constant Name_Id := N + 202;
+ Name_Import_Exception : constant Name_Id := N + 203; -- VMS
+ Name_Import_Function : constant Name_Id := N + 204; -- GNAT
+ Name_Import_Object : constant Name_Id := N + 205; -- GNAT
+ Name_Import_Procedure : constant Name_Id := N + 206; -- GNAT
+ Name_Import_Valued_Procedure : constant Name_Id := N + 207; -- GNAT
+ Name_Inline : constant Name_Id := N + 208;
+ Name_Inline_Always : constant Name_Id := N + 209; -- GNAT
+ Name_Inline_Generic : constant Name_Id := N + 210; -- GNAT
+ Name_Inspection_Point : constant Name_Id := N + 211;
+ Name_Interface_Name : constant Name_Id := N + 212; -- GNAT
+ Name_Interrupt_Handler : constant Name_Id := N + 213;
+ Name_Interrupt_Priority : constant Name_Id := N + 214;
+ Name_Java_Constructor : constant Name_Id := N + 215; -- GNAT
+ Name_Java_Interface : constant Name_Id := N + 216; -- GNAT
+ Name_Keep_Names : constant Name_Id := N + 217; -- GNAT
+ Name_Link_With : constant Name_Id := N + 218; -- GNAT
+ Name_Linker_Alias : constant Name_Id := N + 219; -- GNAT
+ Name_Linker_Constructor : constant Name_Id := N + 220; -- GNAT
+ Name_Linker_Destructor : constant Name_Id := N + 221; -- GNAT
+ Name_Linker_Options : constant Name_Id := N + 222;
+ Name_Linker_Section : constant Name_Id := N + 223; -- GNAT
+ Name_List : constant Name_Id := N + 224;
+ Name_Machine_Attribute : constant Name_Id := N + 225; -- GNAT
+ Name_Main : constant Name_Id := N + 226; -- GNAT
+ Name_Main_Storage : constant Name_Id := N + 227; -- GNAT
+ Name_Memory_Size : constant Name_Id := N + 228; -- Ada 83
+ Name_No_Body : constant Name_Id := N + 229; -- GNAT
+ Name_No_Return : constant Name_Id := N + 230; -- GNAT
+ Name_Obsolescent : constant Name_Id := N + 231; -- GNAT
+ Name_Optimize : constant Name_Id := N + 232;
+ Name_Pack : constant Name_Id := N + 233;
+ Name_Page : constant Name_Id := N + 234;
+ Name_Passive : constant Name_Id := N + 235; -- GNAT
+ Name_Preelaborable_Initialization : constant Name_Id := N + 236; -- Ada 05
+ Name_Preelaborate : constant Name_Id := N + 237;
+ Name_Preelaborate_05 : constant Name_Id := N + 238; -- GNAT
-- Note: Priority is not in this list because its name matches the
-- name of the corresponding attribute. However, it is included in the
-- and Check_Pragma_Id correctly recognize and process Priority.
-- Priority is a standard Ada 95 pragma.
- Name_Psect_Object : constant Name_Id := N + 237; -- VMS
- Name_Pure : constant Name_Id := N + 238;
- Name_Pure_05 : constant Name_Id := N + 239; -- GNAT
- Name_Pure_Function : constant Name_Id := N + 240; -- GNAT
- Name_Remote_Call_Interface : constant Name_Id := N + 241;
- Name_Remote_Types : constant Name_Id := N + 242;
- Name_Share_Generic : constant Name_Id := N + 243; -- GNAT
- Name_Shared : constant Name_Id := N + 244; -- Ada 83
- Name_Shared_Passive : constant Name_Id := N + 245;
+ Name_Psect_Object : constant Name_Id := N + 239; -- VMS
+ Name_Pure : constant Name_Id := N + 240;
+ Name_Pure_05 : constant Name_Id := N + 241; -- GNAT
+ Name_Pure_Function : constant Name_Id := N + 242; -- GNAT
+ Name_Remote_Call_Interface : constant Name_Id := N + 243;
+ Name_Remote_Types : constant Name_Id := N + 244;
+ Name_Share_Generic : constant Name_Id := N + 245; -- GNAT
+ Name_Shared : constant Name_Id := N + 246; -- Ada 83
+ Name_Shared_Passive : constant Name_Id := N + 247;
-- Note: Storage_Size is not in this list because its name matches the
-- name of the corresponding attribute. However, it is included in the
-- Note: Storage_Unit is also omitted from the list because of a clash
-- with an attribute name, and is treated similarly.
- Name_Source_Reference : constant Name_Id := N + 246; -- GNAT
- Name_Static_Elaboration_Desired : constant Name_Id := N + 247; -- GNAT
- Name_Stream_Convert : constant Name_Id := N + 248; -- GNAT
- Name_Subtitle : constant Name_Id := N + 249; -- GNAT
- Name_Suppress_All : constant Name_Id := N + 250; -- GNAT
- Name_Suppress_Debug_Info : constant Name_Id := N + 251; -- GNAT
- Name_Suppress_Initialization : constant Name_Id := N + 252; -- GNAT
- Name_System_Name : constant Name_Id := N + 253; -- Ada 83
- Name_Task_Info : constant Name_Id := N + 254; -- GNAT
- Name_Task_Name : constant Name_Id := N + 255; -- GNAT
- Name_Task_Storage : constant Name_Id := N + 256; -- VMS
- Name_Time_Slice : constant Name_Id := N + 257; -- GNAT
- Name_Title : constant Name_Id := N + 258; -- GNAT
- Name_Unchecked_Union : constant Name_Id := N + 259; -- GNAT
- Name_Unimplemented_Unit : constant Name_Id := N + 260; -- GNAT
- Name_Universal_Aliasing : constant Name_Id := N + 261; -- GNAT
- Name_Unreferenced : constant Name_Id := N + 262; -- GNAT
- Name_Unreferenced_Objects : constant Name_Id := N + 263; -- GNAT
- Name_Unreserve_All_Interrupts : constant Name_Id := N + 264; -- GNAT
- Name_Volatile : constant Name_Id := N + 265;
- Name_Volatile_Components : constant Name_Id := N + 266;
- Name_Weak_External : constant Name_Id := N + 267; -- GNAT
- Last_Pragma_Name : constant Name_Id := N + 267;
+ Name_Source_Reference : constant Name_Id := N + 248; -- GNAT
+ Name_Static_Elaboration_Desired : constant Name_Id := N + 249; -- GNAT
+ Name_Stream_Convert : constant Name_Id := N + 250; -- GNAT
+ Name_Subtitle : constant Name_Id := N + 251; -- GNAT
+ Name_Suppress_All : constant Name_Id := N + 252; -- GNAT
+ Name_Suppress_Debug_Info : constant Name_Id := N + 253; -- GNAT
+ Name_Suppress_Initialization : constant Name_Id := N + 254; -- GNAT
+ Name_System_Name : constant Name_Id := N + 255; -- Ada 83
+ Name_Task_Info : constant Name_Id := N + 256; -- GNAT
+ Name_Task_Name : constant Name_Id := N + 257; -- GNAT
+ Name_Task_Storage : constant Name_Id := N + 258; -- VMS
+ Name_Time_Slice : constant Name_Id := N + 259; -- GNAT
+ Name_Title : constant Name_Id := N + 260; -- GNAT
+ Name_Unchecked_Union : constant Name_Id := N + 261; -- GNAT
+ Name_Unimplemented_Unit : constant Name_Id := N + 262; -- GNAT
+ Name_Universal_Aliasing : constant Name_Id := N + 263; -- GNAT
+ Name_Unreferenced : constant Name_Id := N + 264; -- GNAT
+ Name_Unreferenced_Objects : constant Name_Id := N + 265; -- GNAT
+ Name_Unreserve_All_Interrupts : constant Name_Id := N + 266; -- GNAT
+ Name_Volatile : constant Name_Id := N + 267;
+ Name_Volatile_Components : constant Name_Id := N + 268;
+ Name_Weak_External : constant Name_Id := N + 269; -- GNAT
+ Last_Pragma_Name : constant Name_Id := N + 269;
-- Language convention names for pragma Convention/Export/Import/Interface
-- Note that Name_C is not included in this list, since it was already
-- Entry and Protected, this is because these conventions cannot be
-- specified by a pragma.
- First_Convention_Name : constant Name_Id := N + 268;
- Name_Ada : constant Name_Id := N + 268;
- Name_Assembler : constant Name_Id := N + 269;
- Name_CIL : constant Name_Id := N + 270;
- Name_COBOL : constant Name_Id := N + 271;
- Name_CPP : constant Name_Id := N + 272;
- Name_Fortran : constant Name_Id := N + 273;
- Name_Intrinsic : constant Name_Id := N + 274;
- Name_Java : constant Name_Id := N + 275;
- Name_Stdcall : constant Name_Id := N + 276;
- Name_Stubbed : constant Name_Id := N + 277;
- Last_Convention_Name : constant Name_Id := N + 277;
+ First_Convention_Name : constant Name_Id := N + 270;
+ Name_Ada : constant Name_Id := N + 270;
+ Name_Assembler : constant Name_Id := N + 271;
+ Name_CIL : constant Name_Id := N + 272;
+ Name_COBOL : constant Name_Id := N + 273;
+ Name_CPP : constant Name_Id := N + 274;
+ Name_Fortran : constant Name_Id := N + 275;
+ Name_Intrinsic : constant Name_Id := N + 276;
+ Name_Java : constant Name_Id := N + 277;
+ Name_Stdcall : constant Name_Id := N + 278;
+ Name_Stubbed : constant Name_Id := N + 279;
+ Last_Convention_Name : constant Name_Id := N + 279;
-- The following names are preset as synonyms for Assembler
- Name_Asm : constant Name_Id := N + 278;
- Name_Assembly : constant Name_Id := N + 279;
+ Name_Asm : constant Name_Id := N + 280;
+ Name_Assembly : constant Name_Id := N + 281;
-- 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)
-- 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
- Name_DLL : constant Name_Id := N + 282;
- Name_Win32 : constant Name_Id := N + 283;
+ Name_DLL : constant Name_Id := N + 284;
+ Name_Win32 : constant Name_Id := N + 285;
-- Other special names used in processing pragmas
- Name_As_Is : constant Name_Id := N + 284;
- Name_Attribute_Name : constant Name_Id := N + 285;
- Name_Body_File_Name : constant Name_Id := N + 286;
- Name_Boolean_Entry_Barriers : constant Name_Id := N + 287;
- Name_Check : constant Name_Id := N + 288;
- Name_Casing : constant Name_Id := N + 289;
- Name_Code : constant Name_Id := N + 290;
- Name_Component : constant Name_Id := N + 291;
- Name_Component_Size_4 : constant Name_Id := N + 292;
- Name_Copy : constant Name_Id := N + 293;
- Name_D_Float : constant Name_Id := N + 294;
- Name_Descriptor : constant Name_Id := N + 295;
- Name_Dot_Replacement : constant Name_Id := N + 296;
- Name_Dynamic : constant Name_Id := N + 297;
- Name_Entity : constant Name_Id := N + 298;
- Name_Entry_Count : constant Name_Id := N + 299;
- Name_External_Name : constant Name_Id := N + 300;
- Name_First_Optional_Parameter : constant Name_Id := N + 301;
- Name_Form : constant Name_Id := N + 302;
- Name_G_Float : constant Name_Id := N + 303;
- Name_Gcc : constant Name_Id := N + 304;
- Name_Gnat : constant Name_Id := N + 305;
- Name_GPL : constant Name_Id := N + 306;
- Name_IEEE_Float : constant Name_Id := N + 307;
- Name_Ignore : constant Name_Id := N + 308;
- Name_Info : constant Name_Id := N + 309;
- Name_Internal : constant Name_Id := N + 310;
- Name_Link_Name : constant Name_Id := N + 311;
- Name_Lowercase : constant Name_Id := N + 312;
- Name_Max_Entry_Queue_Depth : constant Name_Id := N + 313;
- Name_Max_Entry_Queue_Length : constant Name_Id := N + 314;
- Name_Max_Size : constant Name_Id := N + 315;
- Name_Mechanism : constant Name_Id := N + 316;
- Name_Message : constant Name_Id := N + 317;
- Name_Mixedcase : constant Name_Id := N + 318;
- Name_Modified_GPL : constant Name_Id := N + 319;
- Name_Name : constant Name_Id := N + 320;
- Name_NCA : constant Name_Id := N + 321;
- Name_No : constant Name_Id := N + 322;
- Name_No_Dependence : constant Name_Id := N + 323;
- Name_No_Dynamic_Attachment : constant Name_Id := N + 324;
- Name_No_Dynamic_Interrupts : constant Name_Id := N + 325;
- Name_No_Requeue : constant Name_Id := N + 326;
- Name_No_Requeue_Statements : constant Name_Id := N + 327;
- Name_No_Task_Attributes : constant Name_Id := N + 328;
- Name_No_Task_Attributes_Package : constant Name_Id := N + 329;
- Name_On : constant Name_Id := N + 330;
- Name_Parameter_Types : constant Name_Id := N + 331;
- Name_Reference : constant Name_Id := N + 332;
- Name_Restricted : constant Name_Id := N + 333;
- Name_Result_Mechanism : constant Name_Id := N + 334;
- Name_Result_Type : constant Name_Id := N + 335;
- Name_Runtime : constant Name_Id := N + 336;
- Name_SB : constant Name_Id := N + 337;
- Name_Secondary_Stack_Size : constant Name_Id := N + 338;
- Name_Section : constant Name_Id := N + 339;
- Name_Semaphore : constant Name_Id := N + 340;
- Name_Simple_Barriers : constant Name_Id := N + 341;
- Name_Spec_File_Name : constant Name_Id := N + 342;
- Name_State : constant Name_Id := N + 343;
- Name_Static : constant Name_Id := N + 344;
- Name_Stack_Size : constant Name_Id := N + 345;
- Name_Subunit_File_Name : constant Name_Id := N + 346;
- Name_Task_Stack_Size_Default : constant Name_Id := N + 347;
- Name_Task_Type : constant Name_Id := N + 348;
- Name_Time_Slicing_Enabled : constant Name_Id := N + 349;
- Name_Top_Guard : constant Name_Id := N + 350;
- Name_UBA : constant Name_Id := N + 351;
- Name_UBS : constant Name_Id := N + 352;
- Name_UBSB : constant Name_Id := N + 353;
- Name_Unit_Name : constant Name_Id := N + 354;
- Name_Unknown : constant Name_Id := N + 355;
- Name_Unrestricted : constant Name_Id := N + 356;
- Name_Uppercase : constant Name_Id := N + 357;
- Name_User : constant Name_Id := N + 358;
- Name_VAX_Float : constant Name_Id := N + 359;
- Name_VMS : constant Name_Id := N + 360;
- Name_Vtable_Ptr : constant Name_Id := N + 361;
- Name_Working_Storage : constant Name_Id := N + 362;
+ Name_As_Is : constant Name_Id := N + 286;
+ Name_Attribute_Name : constant Name_Id := N + 287;
+ Name_Body_File_Name : constant Name_Id := N + 288;
+ Name_Boolean_Entry_Barriers : constant Name_Id := N + 289;
+ Name_Check : constant Name_Id := N + 290;
+ Name_Casing : constant Name_Id := N + 291;
+ Name_Code : constant Name_Id := N + 292;
+ Name_Component : constant Name_Id := N + 293;
+ Name_Component_Size_4 : constant Name_Id := N + 294;
+ Name_Copy : constant Name_Id := N + 295;
+ Name_D_Float : constant Name_Id := N + 296;
+ Name_Descriptor : constant Name_Id := N + 297;
+ Name_Dot_Replacement : constant Name_Id := N + 298;
+ Name_Dynamic : constant Name_Id := N + 299;
+ Name_Entity : constant Name_Id := N + 300;
+ Name_Entry_Count : constant Name_Id := N + 301;
+ Name_External_Name : constant Name_Id := N + 302;
+ Name_First_Optional_Parameter : constant Name_Id := N + 303;
+ Name_Form : constant Name_Id := N + 304;
+ Name_G_Float : constant Name_Id := N + 305;
+ Name_Gcc : constant Name_Id := N + 306;
+ Name_Gnat : constant Name_Id := N + 307;
+ Name_GPL : constant Name_Id := N + 308;
+ Name_IEEE_Float : constant Name_Id := N + 309;
+ Name_Ignore : constant Name_Id := N + 310;
+ Name_Info : constant Name_Id := N + 311;
+ Name_Internal : constant Name_Id := N + 312;
+ Name_Link_Name : constant Name_Id := N + 313;
+ Name_Lowercase : constant Name_Id := N + 314;
+ Name_Max_Entry_Queue_Depth : constant Name_Id := N + 315;
+ Name_Max_Entry_Queue_Length : constant Name_Id := N + 316;
+ Name_Max_Size : constant Name_Id := N + 317;
+ Name_Mechanism : constant Name_Id := N + 318;
+ Name_Message : constant Name_Id := N + 319;
+ Name_Mixedcase : constant Name_Id := N + 320;
+ Name_Modified_GPL : constant Name_Id := N + 321;
+ Name_Name : constant Name_Id := N + 322;
+ Name_NCA : constant Name_Id := N + 323;
+ Name_No : constant Name_Id := N + 324;
+ Name_No_Dependence : constant Name_Id := N + 325;
+ Name_No_Dynamic_Attachment : constant Name_Id := N + 326;
+ Name_No_Dynamic_Interrupts : constant Name_Id := N + 327;
+ Name_No_Requeue : constant Name_Id := N + 328;
+ Name_No_Requeue_Statements : constant Name_Id := N + 329;
+ Name_No_Task_Attributes : constant Name_Id := N + 330;
+ Name_No_Task_Attributes_Package : constant Name_Id := N + 331;
+ Name_On : constant Name_Id := N + 332;
+ Name_Parameter_Types : constant Name_Id := N + 333;
+ Name_Reference : constant Name_Id := N + 334;
+ Name_Restricted : constant Name_Id := N + 335;
+ Name_Result_Mechanism : constant Name_Id := N + 336;
+ Name_Result_Type : constant Name_Id := N + 337;
+ Name_Runtime : constant Name_Id := N + 338;
+ Name_SB : constant Name_Id := N + 339;
+ Name_Secondary_Stack_Size : constant Name_Id := N + 340;
+ Name_Section : constant Name_Id := N + 341;
+ Name_Semaphore : constant Name_Id := N + 342;
+ Name_Simple_Barriers : constant Name_Id := N + 343;
+ Name_Spec_File_Name : constant Name_Id := N + 344;
+ Name_State : constant Name_Id := N + 345;
+ Name_Static : constant Name_Id := N + 346;
+ Name_Stack_Size : constant Name_Id := N + 347;
+ Name_Subunit_File_Name : constant Name_Id := N + 348;
+ Name_Task_Stack_Size_Default : constant Name_Id := N + 349;
+ Name_Task_Type : constant Name_Id := N + 350;
+ Name_Time_Slicing_Enabled : constant Name_Id := N + 351;
+ Name_Top_Guard : constant Name_Id := N + 352;
+ Name_UBA : constant Name_Id := N + 353;
+ Name_UBS : constant Name_Id := N + 354;
+ Name_UBSB : constant Name_Id := N + 355;
+ Name_Unit_Name : constant Name_Id := N + 356;
+ Name_Unknown : constant Name_Id := N + 357;
+ Name_Unrestricted : constant Name_Id := N + 358;
+ Name_Uppercase : constant Name_Id := N + 359;
+ Name_User : constant Name_Id := N + 360;
+ Name_VAX_Float : constant Name_Id := N + 361;
+ Name_VMS : constant Name_Id := N + 362;
+ Name_Vtable_Ptr : constant Name_Id := N + 363;
+ Name_Working_Storage : constant Name_Id := N + 364;
-- 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
-- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts.
- First_Attribute_Name : constant Name_Id := N + 363;
- Name_Abort_Signal : constant Name_Id := N + 363; -- GNAT
- Name_Access : constant Name_Id := N + 364;
- Name_Address : constant Name_Id := N + 365;
- Name_Address_Size : constant Name_Id := N + 366; -- GNAT
- Name_Aft : constant Name_Id := N + 367;
- Name_Alignment : constant Name_Id := N + 368;
- Name_Asm_Input : constant Name_Id := N + 369; -- GNAT
- Name_Asm_Output : constant Name_Id := N + 370; -- GNAT
- Name_AST_Entry : constant Name_Id := N + 371; -- VMS
- Name_Bit : constant Name_Id := N + 372; -- GNAT
- Name_Bit_Order : constant Name_Id := N + 373;
- Name_Bit_Position : constant Name_Id := N + 374; -- GNAT
- Name_Body_Version : constant Name_Id := N + 375;
- Name_Callable : constant Name_Id := N + 376;
- Name_Caller : constant Name_Id := N + 377;
- Name_Code_Address : constant Name_Id := N + 378; -- GNAT
- Name_Component_Size : constant Name_Id := N + 379;
- Name_Compose : constant Name_Id := N + 380;
- Name_Constrained : constant Name_Id := N + 381;
- Name_Count : constant Name_Id := N + 382;
- Name_Default_Bit_Order : constant Name_Id := N + 383; -- GNAT
- Name_Definite : constant Name_Id := N + 384;
- Name_Delta : constant Name_Id := N + 385;
- Name_Denorm : constant Name_Id := N + 386;
- Name_Digits : constant Name_Id := N + 387;
- Name_Elaborated : constant Name_Id := N + 388; -- GNAT
- Name_Emax : constant Name_Id := N + 389; -- Ada 83
- Name_Enum_Rep : constant Name_Id := N + 390; -- GNAT
- Name_Epsilon : constant Name_Id := N + 391; -- Ada 83
- Name_Exponent : constant Name_Id := N + 392;
- Name_External_Tag : constant Name_Id := N + 393;
- Name_First : constant Name_Id := N + 394;
- Name_First_Bit : constant Name_Id := N + 395;
- Name_Fixed_Value : constant Name_Id := N + 396; -- GNAT
- Name_Fore : constant Name_Id := N + 397;
- Name_Has_Access_Values : constant Name_Id := N + 398; -- GNAT
- Name_Has_Discriminants : constant Name_Id := N + 399; -- GNAT
- Name_Identity : constant Name_Id := N + 400;
- Name_Img : constant Name_Id := N + 401; -- GNAT
- Name_Integer_Value : constant Name_Id := N + 402; -- GNAT
- Name_Large : constant Name_Id := N + 403; -- Ada 83
- Name_Last : constant Name_Id := N + 404;
- Name_Last_Bit : constant Name_Id := N + 405;
- Name_Leading_Part : constant Name_Id := N + 406;
- Name_Length : constant Name_Id := N + 407;
- Name_Machine_Emax : constant Name_Id := N + 408;
- Name_Machine_Emin : constant Name_Id := N + 409;
- Name_Machine_Mantissa : constant Name_Id := N + 410;
- Name_Machine_Overflows : constant Name_Id := N + 411;
- Name_Machine_Radix : constant Name_Id := N + 412;
- Name_Machine_Rounding : constant Name_Id := N + 413; -- Ada 05
- Name_Machine_Rounds : constant Name_Id := N + 414;
- Name_Machine_Size : constant Name_Id := N + 415; -- GNAT
- Name_Mantissa : constant Name_Id := N + 416; -- Ada 83
- Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 417;
- Name_Maximum_Alignment : constant Name_Id := N + 418; -- GNAT
- Name_Mechanism_Code : constant Name_Id := N + 419; -- GNAT
- Name_Mod : constant Name_Id := N + 420;
- Name_Model_Emin : constant Name_Id := N + 421;
- Name_Model_Epsilon : constant Name_Id := N + 422;
- Name_Model_Mantissa : constant Name_Id := N + 423;
- Name_Model_Small : constant Name_Id := N + 424;
- Name_Modulus : constant Name_Id := N + 425;
- Name_Null_Parameter : constant Name_Id := N + 426; -- GNAT
- Name_Object_Size : constant Name_Id := N + 427; -- GNAT
- Name_Partition_ID : constant Name_Id := N + 428;
- Name_Passed_By_Reference : constant Name_Id := N + 429; -- GNAT
- Name_Pool_Address : constant Name_Id := N + 430;
- Name_Pos : constant Name_Id := N + 431;
- Name_Position : constant Name_Id := N + 432;
- Name_Priority : constant Name_Id := N + 433; -- Ada 05
- Name_Range : constant Name_Id := N + 434;
- Name_Range_Length : constant Name_Id := N + 435; -- GNAT
- Name_Round : constant Name_Id := N + 436;
- Name_Safe_Emax : constant Name_Id := N + 437; -- Ada 83
- Name_Safe_First : constant Name_Id := N + 438;
- Name_Safe_Large : constant Name_Id := N + 439; -- Ada 83
- Name_Safe_Last : constant Name_Id := N + 440;
- Name_Safe_Small : constant Name_Id := N + 441; -- Ada 83
- Name_Scale : constant Name_Id := N + 442;
- Name_Scaling : constant Name_Id := N + 443;
- Name_Signed_Zeros : constant Name_Id := N + 444;
- Name_Size : constant Name_Id := N + 445;
- Name_Small : constant Name_Id := N + 446;
- Name_Storage_Size : constant Name_Id := N + 447;
- Name_Storage_Unit : constant Name_Id := N + 448; -- GNAT
- Name_Stream_Size : constant Name_Id := N + 449; -- Ada 05
- Name_Tag : constant Name_Id := N + 450;
- Name_Target_Name : constant Name_Id := N + 451; -- GNAT
- Name_Terminated : constant Name_Id := N + 452;
- Name_To_Address : constant Name_Id := N + 453; -- GNAT
- Name_Type_Class : constant Name_Id := N + 454; -- GNAT
- Name_UET_Address : constant Name_Id := N + 455; -- GNAT
- Name_Unbiased_Rounding : constant Name_Id := N + 456;
- Name_Unchecked_Access : constant Name_Id := N + 457;
- Name_Unconstrained_Array : constant Name_Id := N + 458;
- Name_Universal_Literal_String : constant Name_Id := N + 459; -- GNAT
- Name_Unrestricted_Access : constant Name_Id := N + 460; -- GNAT
- Name_VADS_Size : constant Name_Id := N + 461; -- GNAT
- Name_Val : constant Name_Id := N + 462;
- Name_Valid : constant Name_Id := N + 463;
- Name_Value_Size : constant Name_Id := N + 464; -- GNAT
- Name_Version : constant Name_Id := N + 465;
- Name_Wchar_T_Size : constant Name_Id := N + 466; -- GNAT
- Name_Wide_Wide_Width : constant Name_Id := N + 467; -- Ada 05
- Name_Wide_Width : constant Name_Id := N + 468;
- Name_Width : constant Name_Id := N + 469;
- Name_Word_Size : constant Name_Id := N + 470; -- GNAT
+ First_Attribute_Name : constant Name_Id := N + 365;
+ Name_Abort_Signal : constant Name_Id := N + 365; -- GNAT
+ Name_Access : constant Name_Id := N + 366;
+ Name_Address : constant Name_Id := N + 367;
+ Name_Address_Size : constant Name_Id := N + 368; -- GNAT
+ Name_Aft : constant Name_Id := N + 369;
+ Name_Alignment : constant Name_Id := N + 370;
+ Name_Asm_Input : constant Name_Id := N + 371; -- GNAT
+ Name_Asm_Output : constant Name_Id := N + 372; -- GNAT
+ Name_AST_Entry : constant Name_Id := N + 373; -- VMS
+ Name_Bit : constant Name_Id := N + 374; -- GNAT
+ Name_Bit_Order : constant Name_Id := N + 375;
+ Name_Bit_Position : constant Name_Id := N + 376; -- GNAT
+ Name_Body_Version : constant Name_Id := N + 377;
+ Name_Callable : constant Name_Id := N + 378;
+ Name_Caller : constant Name_Id := N + 379;
+ Name_Code_Address : constant Name_Id := N + 380; -- GNAT
+ Name_Component_Size : constant Name_Id := N + 381;
+ Name_Compose : constant Name_Id := N + 382;
+ Name_Constrained : constant Name_Id := N + 383;
+ Name_Count : constant Name_Id := N + 384;
+ Name_Default_Bit_Order : constant Name_Id := N + 385; -- GNAT
+ Name_Definite : constant Name_Id := N + 386;
+ Name_Delta : constant Name_Id := N + 387;
+ Name_Denorm : constant Name_Id := N + 388;
+ Name_Digits : constant Name_Id := N + 389;
+ Name_Elaborated : constant Name_Id := N + 390; -- GNAT
+ Name_Emax : constant Name_Id := N + 391; -- Ada 83
+ Name_Enabled : constant Name_Id := N + 392; -- GNAT
+ Name_Enum_Rep : constant Name_Id := N + 393; -- GNAT
+ Name_Epsilon : constant Name_Id := N + 394; -- Ada 83
+ Name_Exponent : constant Name_Id := N + 395;
+ Name_External_Tag : constant Name_Id := N + 396;
+ Name_First : constant Name_Id := N + 397;
+ Name_First_Bit : constant Name_Id := N + 398;
+ Name_Fixed_Value : constant Name_Id := N + 399; -- GNAT
+ Name_Fore : constant Name_Id := N + 400;
+ Name_Has_Access_Values : constant Name_Id := N + 401; -- GNAT
+ Name_Has_Discriminants : constant Name_Id := N + 402; -- GNAT
+ Name_Identity : constant Name_Id := N + 403;
+ Name_Img : constant Name_Id := N + 404; -- GNAT
+ Name_Integer_Value : constant Name_Id := N + 405; -- GNAT
+ Name_Large : constant Name_Id := N + 406; -- Ada 83
+ Name_Last : constant Name_Id := N + 407;
+ Name_Last_Bit : constant Name_Id := N + 408;
+ Name_Leading_Part : constant Name_Id := N + 409;
+ Name_Length : constant Name_Id := N + 410;
+ Name_Machine_Emax : constant Name_Id := N + 411;
+ Name_Machine_Emin : constant Name_Id := N + 412;
+ Name_Machine_Mantissa : constant Name_Id := N + 413;
+ Name_Machine_Overflows : constant Name_Id := N + 414;
+ Name_Machine_Radix : constant Name_Id := N + 415;
+ Name_Machine_Rounding : constant Name_Id := N + 416; -- Ada 05
+ Name_Machine_Rounds : constant Name_Id := N + 417;
+ Name_Machine_Size : constant Name_Id := N + 418; -- GNAT
+ Name_Mantissa : constant Name_Id := N + 419; -- Ada 83
+ Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 420;
+ Name_Maximum_Alignment : constant Name_Id := N + 421; -- GNAT
+ Name_Mechanism_Code : constant Name_Id := N + 422; -- GNAT
+ Name_Mod : constant Name_Id := N + 423; -- Ada 05
+ Name_Model_Emin : constant Name_Id := N + 424;
+ Name_Model_Epsilon : constant Name_Id := N + 425;
+ Name_Model_Mantissa : constant Name_Id := N + 426;
+ Name_Model_Small : constant Name_Id := N + 427;
+ Name_Modulus : constant Name_Id := N + 428;
+ Name_Null_Parameter : constant Name_Id := N + 429; -- GNAT
+ Name_Object_Size : constant Name_Id := N + 430; -- GNAT
+ Name_Partition_ID : constant Name_Id := N + 431;
+ Name_Passed_By_Reference : constant Name_Id := N + 432; -- GNAT
+ Name_Pool_Address : constant Name_Id := N + 433;
+ Name_Pos : constant Name_Id := N + 434;
+ Name_Position : constant Name_Id := N + 435;
+ Name_Priority : constant Name_Id := N + 436; -- Ada 05
+ Name_Range : constant Name_Id := N + 437;
+ Name_Range_Length : constant Name_Id := N + 438; -- GNAT
+ Name_Round : constant Name_Id := N + 439;
+ Name_Safe_Emax : constant Name_Id := N + 440; -- Ada 83
+ Name_Safe_First : constant Name_Id := N + 441;
+ Name_Safe_Large : constant Name_Id := N + 442; -- Ada 83
+ Name_Safe_Last : constant Name_Id := N + 443;
+ Name_Safe_Small : constant Name_Id := N + 444; -- Ada 83
+ Name_Scale : constant Name_Id := N + 445;
+ Name_Scaling : constant Name_Id := N + 446;
+ Name_Signed_Zeros : constant Name_Id := N + 447;
+ Name_Size : constant Name_Id := N + 448;
+ Name_Small : constant Name_Id := N + 449;
+ Name_Storage_Size : constant Name_Id := N + 450;
+ Name_Storage_Unit : constant Name_Id := N + 451; -- GNAT
+ Name_Stream_Size : constant Name_Id := N + 452; -- Ada 05
+ Name_Tag : constant Name_Id := N + 453;
+ Name_Target_Name : constant Name_Id := N + 454; -- GNAT
+ Name_Terminated : constant Name_Id := N + 455;
+ Name_To_Address : constant Name_Id := N + 456; -- GNAT
+ Name_Type_Class : constant Name_Id := N + 457; -- GNAT
+ Name_UET_Address : constant Name_Id := N + 458; -- GNAT
+ Name_Unbiased_Rounding : constant Name_Id := N + 459;
+ Name_Unchecked_Access : constant Name_Id := N + 460;
+ Name_Unconstrained_Array : constant Name_Id := N + 461;
+ Name_Universal_Literal_String : constant Name_Id := N + 462; -- GNAT
+ Name_Unrestricted_Access : constant Name_Id := N + 463; -- GNAT
+ Name_VADS_Size : constant Name_Id := N + 464; -- GNAT
+ Name_Val : constant Name_Id := N + 465;
+ Name_Valid : constant Name_Id := N + 466;
+ Name_Value_Size : constant Name_Id := N + 467; -- GNAT
+ Name_Version : constant Name_Id := N + 468;
+ Name_Wchar_T_Size : constant Name_Id := N + 469; -- GNAT
+ Name_Wide_Wide_Width : constant Name_Id := N + 470; -- Ada 05
+ Name_Wide_Width : constant Name_Id := N + 471;
+ Name_Width : constant Name_Id := N + 472;
+ Name_Word_Size : constant Name_Id := N + 473; -- GNAT
-- Attributes that designate attributes returning renamable functions,
-- i.e. functions that return other than a universal value and that
-- have non-universal arguments.
- First_Renamable_Function_Attribute : constant Name_Id := N + 471;
- Name_Adjacent : constant Name_Id := N + 471;
- Name_Ceiling : constant Name_Id := N + 472;
- Name_Copy_Sign : constant Name_Id := N + 473;
- Name_Floor : constant Name_Id := N + 474;
- Name_Fraction : constant Name_Id := N + 475;
- Name_Image : constant Name_Id := N + 476;
- Name_Input : constant Name_Id := N + 477;
- Name_Machine : constant Name_Id := N + 478;
- Name_Max : constant Name_Id := N + 479;
- Name_Min : constant Name_Id := N + 480;
- Name_Model : constant Name_Id := N + 481;
- Name_Pred : constant Name_Id := N + 482;
- Name_Remainder : constant Name_Id := N + 483;
- Name_Rounding : constant Name_Id := N + 484;
- Name_Succ : constant Name_Id := N + 485;
- Name_Truncation : constant Name_Id := N + 486;
- Name_Value : constant Name_Id := N + 487;
- Name_Wide_Image : constant Name_Id := N + 488;
- Name_Wide_Wide_Image : constant Name_Id := N + 489;
- Name_Wide_Value : constant Name_Id := N + 490;
- Name_Wide_Wide_Value : constant Name_Id := N + 491;
- Last_Renamable_Function_Attribute : constant Name_Id := N + 491;
+ First_Renamable_Function_Attribute : constant Name_Id := N + 474;
+ Name_Adjacent : constant Name_Id := N + 474;
+ Name_Ceiling : constant Name_Id := N + 475;
+ Name_Copy_Sign : constant Name_Id := N + 476;
+ Name_Floor : constant Name_Id := N + 477;
+ Name_Fraction : constant Name_Id := N + 478;
+ Name_Image : constant Name_Id := N + 479;
+ Name_Input : constant Name_Id := N + 480;
+ Name_Machine : constant Name_Id := N + 481;
+ Name_Max : constant Name_Id := N + 482;
+ Name_Min : constant Name_Id := N + 483;
+ Name_Model : constant Name_Id := N + 484;
+ Name_Pred : constant Name_Id := N + 485;
+ Name_Remainder : constant Name_Id := N + 486;
+ Name_Rounding : constant Name_Id := N + 487;
+ Name_Succ : constant Name_Id := N + 488;
+ Name_Truncation : constant Name_Id := N + 489;
+ Name_Value : constant Name_Id := N + 490;
+ Name_Wide_Image : constant Name_Id := N + 491;
+ Name_Wide_Wide_Image : constant Name_Id := N + 492;
+ Name_Wide_Value : constant Name_Id := N + 493;
+ Name_Wide_Wide_Value : constant Name_Id := N + 494;
+ Last_Renamable_Function_Attribute : constant Name_Id := N + 494;
-- Attributes that designate procedures
- First_Procedure_Attribute : constant Name_Id := N + 492;
- Name_Output : constant Name_Id := N + 492;
- Name_Read : constant Name_Id := N + 493;
- Name_Write : constant Name_Id := N + 494;
- Last_Procedure_Attribute : constant Name_Id := N + 494;
+ First_Procedure_Attribute : constant Name_Id := N + 495;
+ Name_Output : constant Name_Id := N + 495;
+ Name_Read : constant Name_Id := N + 496;
+ Name_Write : constant Name_Id := N + 497;
+ Last_Procedure_Attribute : constant Name_Id := N + 497;
-- Remaining attributes are ones that return entities
- First_Entity_Attribute_Name : constant Name_Id := N + 495;
- Name_Elab_Body : constant Name_Id := N + 495; -- GNAT
- Name_Elab_Spec : constant Name_Id := N + 496; -- GNAT
- Name_Storage_Pool : constant Name_Id := N + 497;
+ First_Entity_Attribute_Name : constant Name_Id := N + 498;
+ Name_Elab_Body : constant Name_Id := N + 498; -- GNAT
+ Name_Elab_Spec : constant Name_Id := N + 499; -- GNAT
+ Name_Storage_Pool : constant Name_Id := N + 500;
-- These attributes are the ones that return types
- First_Type_Attribute_Name : constant Name_Id := N + 498;
- Name_Base : constant Name_Id := N + 498;
- Name_Class : constant Name_Id := N + 499;
- Name_Stub_Type : constant Name_Id := N + 500;
- Last_Type_Attribute_Name : constant Name_Id := N + 500;
- Last_Entity_Attribute_Name : constant Name_Id := N + 500;
- Last_Attribute_Name : constant Name_Id := N + 500;
+ First_Type_Attribute_Name : constant Name_Id := N + 501;
+ Name_Base : constant Name_Id := N + 501;
+ Name_Class : constant Name_Id := N + 502;
+ Name_Stub_Type : constant Name_Id := N + 503;
+ Last_Type_Attribute_Name : constant Name_Id := N + 503;
+ Last_Entity_Attribute_Name : constant Name_Id := N + 503;
+ Last_Attribute_Name : constant Name_Id := N + 503;
-- Names of recognized locking policy identifiers
-- name (e.g. C for Ceiling_Locking). If new policy names are added,
-- the first character must be distinct.
- First_Locking_Policy_Name : constant Name_Id := N + 501;
- Name_Ceiling_Locking : constant Name_Id := N + 501;
- Name_Inheritance_Locking : constant Name_Id := N + 502;
- Last_Locking_Policy_Name : constant Name_Id := N + 502;
+ First_Locking_Policy_Name : constant Name_Id := N + 504;
+ Name_Ceiling_Locking : constant Name_Id := N + 504;
+ Name_Inheritance_Locking : constant Name_Id := N + 505;
+ Last_Locking_Policy_Name : constant Name_Id := N + 505;
-- Names of recognized queuing policy identifiers
-- name (e.g. F for FIFO_Queuing). If new policy names are added,
-- the first character must be distinct.
- First_Queuing_Policy_Name : constant Name_Id := N + 503;
- Name_FIFO_Queuing : constant Name_Id := N + 503;
- Name_Priority_Queuing : constant Name_Id := N + 504;
- Last_Queuing_Policy_Name : constant Name_Id := N + 504;
+ First_Queuing_Policy_Name : constant Name_Id := N + 506;
+ Name_FIFO_Queuing : constant Name_Id := N + 506;
+ Name_Priority_Queuing : constant Name_Id := N + 507;
+ Last_Queuing_Policy_Name : constant Name_Id := N + 507;
-- Names of recognized task dispatching policy identifiers
-- name (e.g. F for FIFO_Within_Priorities). If new policy names
-- are added, the first character must be distinct.
- First_Task_Dispatching_Policy_Name : constant Name_Id := N + 505;
- Name_EDF_Across_Priorities : constant Name_Id := N + 505;
- Name_FIFO_Within_Priorities : constant Name_Id := N + 506;
- Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 507;
- Name_Round_Robin_Within_Priorities : constant Name_Id := N + 508;
- Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 508;
+ First_Task_Dispatching_Policy_Name : constant Name_Id := N + 508;
+ Name_EDF_Across_Priorities : constant Name_Id := N + 508;
+ Name_FIFO_Within_Priorities : constant Name_Id := N + 509;
+ Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 510;
+ Name_Round_Robin_Within_Priorities : constant Name_Id := N + 511;
+ Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 511;
-- Names of recognized checks for pragma Suppress
- First_Check_Name : constant Name_Id := N + 509;
- Name_Access_Check : constant Name_Id := N + 509;
- Name_Accessibility_Check : constant Name_Id := N + 510;
- Name_Alignment_Check : constant Name_Id := N + 511;
- Name_Discriminant_Check : constant Name_Id := N + 512;
- Name_Division_Check : constant Name_Id := N + 513;
- Name_Elaboration_Check : constant Name_Id := N + 514;
- Name_Index_Check : constant Name_Id := N + 515;
- Name_Length_Check : constant Name_Id := N + 516;
- Name_Overflow_Check : constant Name_Id := N + 517;
- Name_Range_Check : constant Name_Id := N + 518;
- Name_Storage_Check : constant Name_Id := N + 519;
- Name_Tag_Check : constant Name_Id := N + 520;
- Name_Validity_Check : constant Name_Id := N + 521;
- Name_All_Checks : constant Name_Id := N + 522;
- Last_Check_Name : constant Name_Id := N + 522;
+ First_Check_Name : constant Name_Id := N + 512;
+ Name_Access_Check : constant Name_Id := N + 512;
+ Name_Accessibility_Check : constant Name_Id := N + 513;
+ Name_Alignment_Check : constant Name_Id := N + 514; -- GNAT
+ Name_Discriminant_Check : constant Name_Id := N + 515;
+ Name_Division_Check : constant Name_Id := N + 516;
+ Name_Elaboration_Check : constant Name_Id := N + 517;
+ Name_Index_Check : constant Name_Id := N + 518;
+ Name_Length_Check : constant Name_Id := N + 519;
+ Name_Overflow_Check : constant Name_Id := N + 520;
+ Name_Range_Check : constant Name_Id := N + 521;
+ Name_Storage_Check : constant Name_Id := N + 522;
+ Name_Tag_Check : constant Name_Id := N + 523;
+ Name_Validity_Check : constant Name_Id := N + 524; -- GNAT
+ Name_All_Checks : constant Name_Id := N + 525;
+ Last_Check_Name : constant Name_Id := N + 525;
-- Names corresponding to reserved keywords, excluding those already
-- declared in the attribute list (Access, Delta, Digits, Mod, Range).
- Name_Abort : constant Name_Id := N + 523;
- Name_Abs : constant Name_Id := N + 524;
- Name_Accept : constant Name_Id := N + 525;
- Name_And : constant Name_Id := N + 526;
- Name_All : constant Name_Id := N + 527;
- Name_Array : constant Name_Id := N + 528;
- Name_At : constant Name_Id := N + 529;
- Name_Begin : constant Name_Id := N + 530;
- Name_Body : constant Name_Id := N + 531;
- Name_Case : constant Name_Id := N + 532;
- Name_Constant : constant Name_Id := N + 533;
- Name_Declare : constant Name_Id := N + 534;
- Name_Delay : constant Name_Id := N + 535;
- Name_Do : constant Name_Id := N + 536;
- Name_Else : constant Name_Id := N + 537;
- Name_Elsif : constant Name_Id := N + 538;
- Name_End : constant Name_Id := N + 539;
- Name_Entry : constant Name_Id := N + 540;
- Name_Exception : constant Name_Id := N + 541;
- Name_Exit : constant Name_Id := N + 542;
- Name_For : constant Name_Id := N + 543;
- Name_Function : constant Name_Id := N + 544;
- Name_Generic : constant Name_Id := N + 545;
- Name_Goto : constant Name_Id := N + 546;
- Name_If : constant Name_Id := N + 547;
- Name_In : constant Name_Id := N + 548;
- Name_Is : constant Name_Id := N + 549;
- Name_Limited : constant Name_Id := N + 550;
- Name_Loop : constant Name_Id := N + 551;
- Name_New : constant Name_Id := N + 552;
- Name_Not : constant Name_Id := N + 553;
- Name_Null : constant Name_Id := N + 554;
- Name_Of : constant Name_Id := N + 555;
- Name_Or : constant Name_Id := N + 556;
- Name_Others : constant Name_Id := N + 557;
- Name_Out : constant Name_Id := N + 558;
- Name_Package : constant Name_Id := N + 559;
- Name_Pragma : constant Name_Id := N + 560;
- Name_Private : constant Name_Id := N + 561;
- Name_Procedure : constant Name_Id := N + 562;
- Name_Raise : constant Name_Id := N + 563;
- Name_Record : constant Name_Id := N + 564;
- Name_Rem : constant Name_Id := N + 565;
- Name_Renames : constant Name_Id := N + 566;
- Name_Return : constant Name_Id := N + 567;
- Name_Reverse : constant Name_Id := N + 568;
- Name_Select : constant Name_Id := N + 569;
- Name_Separate : constant Name_Id := N + 570;
- Name_Subtype : constant Name_Id := N + 571;
- Name_Task : constant Name_Id := N + 572;
- Name_Terminate : constant Name_Id := N + 573;
- Name_Then : constant Name_Id := N + 574;
- Name_Type : constant Name_Id := N + 575;
- Name_Use : constant Name_Id := N + 576;
- Name_When : constant Name_Id := N + 577;
- Name_While : constant Name_Id := N + 578;
- Name_With : constant Name_Id := N + 579;
- Name_Xor : constant Name_Id := N + 580;
+ Name_Abort : constant Name_Id := N + 526;
+ Name_Abs : constant Name_Id := N + 527;
+ Name_Accept : constant Name_Id := N + 528;
+ Name_And : constant Name_Id := N + 529;
+ Name_All : constant Name_Id := N + 530;
+ Name_Array : constant Name_Id := N + 531;
+ Name_At : constant Name_Id := N + 532;
+ Name_Begin : constant Name_Id := N + 533;
+ Name_Body : constant Name_Id := N + 534;
+ Name_Case : constant Name_Id := N + 535;
+ Name_Constant : constant Name_Id := N + 536;
+ Name_Declare : constant Name_Id := N + 537;
+ Name_Delay : constant Name_Id := N + 538;
+ Name_Do : constant Name_Id := N + 539;
+ Name_Else : constant Name_Id := N + 540;
+ Name_Elsif : constant Name_Id := N + 541;
+ Name_End : constant Name_Id := N + 542;
+ Name_Entry : constant Name_Id := N + 543;
+ Name_Exception : constant Name_Id := N + 544;
+ Name_Exit : constant Name_Id := N + 545;
+ Name_For : constant Name_Id := N + 546;
+ Name_Function : constant Name_Id := N + 547;
+ Name_Generic : constant Name_Id := N + 548;
+ Name_Goto : constant Name_Id := N + 549;
+ Name_If : constant Name_Id := N + 550;
+ Name_In : constant Name_Id := N + 551;
+ Name_Is : constant Name_Id := N + 552;
+ Name_Limited : constant Name_Id := N + 553;
+ Name_Loop : constant Name_Id := N + 554;
+ Name_New : constant Name_Id := N + 555;
+ Name_Not : constant Name_Id := N + 556;
+ Name_Null : constant Name_Id := N + 557;
+ Name_Of : constant Name_Id := N + 558;
+ Name_Or : constant Name_Id := N + 559;
+ Name_Others : constant Name_Id := N + 560;
+ Name_Out : constant Name_Id := N + 561;
+ Name_Package : constant Name_Id := N + 562;
+ Name_Pragma : constant Name_Id := N + 563;
+ Name_Private : constant Name_Id := N + 564;
+ Name_Procedure : constant Name_Id := N + 565;
+ Name_Raise : constant Name_Id := N + 566;
+ Name_Record : constant Name_Id := N + 567;
+ Name_Rem : constant Name_Id := N + 568;
+ Name_Renames : constant Name_Id := N + 569;
+ Name_Return : constant Name_Id := N + 570;
+ Name_Reverse : constant Name_Id := N + 571;
+ Name_Select : constant Name_Id := N + 572;
+ Name_Separate : constant Name_Id := N + 573;
+ Name_Subtype : constant Name_Id := N + 574;
+ Name_Task : constant Name_Id := N + 575;
+ Name_Terminate : constant Name_Id := N + 576;
+ Name_Then : constant Name_Id := N + 577;
+ Name_Type : constant Name_Id := N + 578;
+ Name_Use : constant Name_Id := N + 579;
+ Name_When : constant Name_Id := N + 580;
+ Name_While : constant Name_Id := N + 581;
+ Name_With : constant Name_Id := N + 582;
+ Name_Xor : constant Name_Id := N + 583;
-- Names of intrinsic subprograms
-- Note: Asm is missing from this list, since Asm is a legitimate
-- convention name. So is To_Adress, which is a GNAT attribute.
- First_Intrinsic_Name : constant Name_Id := N + 581;
- Name_Divide : constant Name_Id := N + 581;
- Name_Enclosing_Entity : constant Name_Id := N + 582;
- Name_Exception_Information : constant Name_Id := N + 583;
- Name_Exception_Message : constant Name_Id := N + 584;
- Name_Exception_Name : constant Name_Id := N + 585;
- Name_File : constant Name_Id := N + 586;
- Name_Generic_Dispatching_Constructor : constant Name_Id := N + 587;
- Name_Import_Address : constant Name_Id := N + 588;
- Name_Import_Largest_Value : constant Name_Id := N + 589;
- Name_Import_Value : constant Name_Id := N + 590;
- Name_Is_Negative : constant Name_Id := N + 591;
- Name_Line : constant Name_Id := N + 592;
- Name_Rotate_Left : constant Name_Id := N + 593;
- Name_Rotate_Right : constant Name_Id := N + 594;
- Name_Shift_Left : constant Name_Id := N + 595;
- Name_Shift_Right : constant Name_Id := N + 596;
- Name_Shift_Right_Arithmetic : constant Name_Id := N + 597;
- Name_Source_Location : constant Name_Id := N + 598;
- Name_Unchecked_Conversion : constant Name_Id := N + 599;
- Name_Unchecked_Deallocation : constant Name_Id := N + 600;
- Name_To_Pointer : constant Name_Id := N + 601;
- Last_Intrinsic_Name : constant Name_Id := N + 601;
+ First_Intrinsic_Name : constant Name_Id := N + 584;
+ Name_Divide : constant Name_Id := N + 584;
+ Name_Enclosing_Entity : constant Name_Id := N + 585;
+ Name_Exception_Information : constant Name_Id := N + 586;
+ Name_Exception_Message : constant Name_Id := N + 587;
+ Name_Exception_Name : constant Name_Id := N + 588;
+ Name_File : constant Name_Id := N + 589;
+ Name_Generic_Dispatching_Constructor : constant Name_Id := N + 590;
+ Name_Import_Address : constant Name_Id := N + 591;
+ Name_Import_Largest_Value : constant Name_Id := N + 592;
+ Name_Import_Value : constant Name_Id := N + 593;
+ Name_Is_Negative : constant Name_Id := N + 594;
+ Name_Line : constant Name_Id := N + 595;
+ Name_Rotate_Left : constant Name_Id := N + 596;
+ Name_Rotate_Right : constant Name_Id := N + 597;
+ Name_Shift_Left : constant Name_Id := N + 598;
+ Name_Shift_Right : constant Name_Id := N + 599;
+ Name_Shift_Right_Arithmetic : constant Name_Id := N + 600;
+ Name_Source_Location : constant Name_Id := N + 601;
+ Name_Unchecked_Conversion : constant Name_Id := N + 602;
+ Name_Unchecked_Deallocation : constant Name_Id := N + 603;
+ Name_To_Pointer : constant Name_Id := N + 604;
+ Last_Intrinsic_Name : constant Name_Id := N + 604;
-- 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
- First_95_Reserved_Word : constant Name_Id := N + 603;
- Name_Abstract : constant Name_Id := N + 603;
- Name_Aliased : constant Name_Id := N + 604;
- Name_Protected : constant Name_Id := N + 605;
- Name_Until : constant Name_Id := N + 606;
- Name_Requeue : constant Name_Id := N + 607;
- Name_Tagged : constant Name_Id := N + 608;
- Last_95_Reserved_Word : constant Name_Id := N + 608;
+ First_95_Reserved_Word : constant Name_Id := N + 606;
+ Name_Abstract : constant Name_Id := N + 606;
+ Name_Aliased : constant Name_Id := N + 607;
+ Name_Protected : constant Name_Id := N + 608;
+ Name_Until : constant Name_Id := N + 609;
+ Name_Requeue : constant Name_Id := N + 610;
+ Name_Tagged : constant Name_Id := N + 611;
+ Last_95_Reserved_Word : constant Name_Id := N + 611;
subtype Ada_95_Reserved_Words is
Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
-- 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
-- Note that Name_External is already previously declared
- Name_Ada_Roots : constant Name_Id := N + 610;
- Name_Archive_Builder : constant Name_Id := N + 611;
- Name_Archive_Indexer : constant Name_Id := N + 612;
- Name_Archive_Suffix : constant Name_Id := N + 613;
- Name_Binder : constant Name_Id := N + 614;
- Name_Binder_Driver : constant Name_Id := N + 615;
- Name_Binder_Prefix : constant Name_Id := N + 616;
- Name_Body_Suffix : constant Name_Id := N + 617;
- Name_Builder : constant Name_Id := N + 618;
- Name_Builder_Switches : constant Name_Id := N + 619;
- Name_Compiler : constant Name_Id := N + 620;
- Name_Compiler_Driver : constant Name_Id := N + 621;
- Name_Compiler_Kind : constant Name_Id := N + 622;
- Name_Compiler_Pic_Option : constant Name_Id := N + 623;
- Name_Compute_Dependency : constant Name_Id := N + 624;
- Name_Config_Body_File_Name : constant Name_Id := N + 625;
- Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 626;
- Name_Config_File_Switches : constant Name_Id := N + 627;
- Name_Config_File_Unique : constant Name_Id := N + 628;
- Name_Config_Spec_File_Name : constant Name_Id := N + 629;
- Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 630;
- Name_Cross_Reference : constant Name_Id := N + 631;
- Name_Default_Builder_Switches : constant Name_Id := N + 632;
- Name_Default_Global_Compiler_Switches : constant Name_Id := N + 633;
- Name_Default_Language : constant Name_Id := N + 634;
- Name_Default_Linker : constant Name_Id := N + 635;
- Name_Default_Minimum_Linker_Options : constant Name_Id := N + 636;
- Name_Default_Switches : constant Name_Id := N + 637;
- Name_Dependency_File_Kind : constant Name_Id := N + 638;
- Name_Dependency_Option : constant Name_Id := N + 639;
- Name_Exec_Dir : constant Name_Id := N + 640;
- Name_Executable : constant Name_Id := N + 641;
- Name_Executable_Suffix : constant Name_Id := N + 642;
- Name_Extends : constant Name_Id := N + 643;
- Name_Externally_Built : constant Name_Id := N + 644;
- Name_Finder : constant Name_Id := N + 645;
- Name_Global_Compiler_Switches : constant Name_Id := N + 646;
- Name_Global_Configuration_Pragmas : constant Name_Id := N + 647;
- Name_Global_Config_File : constant Name_Id := N + 648;
- Name_Gnatls : constant Name_Id := N + 649;
- Name_Gnatstub : constant Name_Id := N + 650;
- Name_Implementation : constant Name_Id := N + 651;
- Name_Implementation_Exceptions : constant Name_Id := N + 652;
- Name_Implementation_Suffix : constant Name_Id := N + 653;
- Name_Include_Option : constant Name_Id := N + 654;
- Name_Include_Path : constant Name_Id := N + 655;
- Name_Include_Path_File : constant Name_Id := N + 656;
- Name_Language_Kind : constant Name_Id := N + 657;
- Name_Language_Processing : constant Name_Id := N + 658;
- Name_Languages : constant Name_Id := N + 659;
- Name_Library_Ali_Dir : constant Name_Id := N + 660;
- Name_Library_Auto_Init : constant Name_Id := N + 661;
- Name_Library_Auto_Init_Supported : constant Name_Id := N + 662;
- Name_Library_Builder : constant Name_Id := N + 663;
- Name_Library_Dir : constant Name_Id := N + 664;
- Name_Library_GCC : constant Name_Id := N + 665;
- Name_Library_Interface : constant Name_Id := N + 666;
- Name_Library_Kind : constant Name_Id := N + 667;
- Name_Library_Name : constant Name_Id := N + 668;
- Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 669;
- Name_Library_Options : constant Name_Id := N + 670;
- Name_Library_Partial_Linker : constant Name_Id := N + 671;
- Name_Library_Reference_Symbol_File : constant Name_Id := N + 672;
- Name_Library_Src_Dir : constant Name_Id := N + 673;
- Name_Library_Support : constant Name_Id := N + 674;
- Name_Library_Symbol_File : constant Name_Id := N + 675;
- Name_Library_Symbol_Policy : constant Name_Id := N + 676;
- Name_Library_Version : constant Name_Id := N + 677;
- Name_Library_Version_Options : constant Name_Id := N + 678;
- Name_Linker : constant Name_Id := N + 679;
- Name_Linker_Executable_Option : constant Name_Id := N + 680;
- Name_Linker_Lib_Dir_Option : constant Name_Id := N + 681;
- Name_Linker_Lib_Name_Option : constant Name_Id := N + 682;
- Name_Local_Config_File : constant Name_Id := N + 683;
- Name_Local_Configuration_Pragmas : constant Name_Id := N + 684;
- Name_Locally_Removed_Files : constant Name_Id := N + 685;
- Name_Mapping_File_Switches : constant Name_Id := N + 686;
- Name_Mapping_Spec_Suffix : constant Name_Id := N + 687;
- Name_Mapping_Body_Suffix : constant Name_Id := N + 688;
- Name_Metrics : constant Name_Id := N + 689;
- Name_Minimum_Binder_Options : constant Name_Id := N + 690;
- Name_Minimum_Compiler_Options : constant Name_Id := N + 691;
- Name_Minimum_Linker_Options : constant Name_Id := N + 692;
- Name_Naming : constant Name_Id := N + 693;
- Name_Objects_Path : constant Name_Id := N + 694;
- Name_Objects_Path_File : constant Name_Id := N + 695;
- Name_Object_Dir : constant Name_Id := N + 696;
- Name_Pretty_Printer : constant Name_Id := N + 697;
- Name_Project : constant Name_Id := N + 698;
- Name_Roots : constant Name_Id := N + 699;
- Name_Run_Path_Option : constant Name_Id := N + 700;
- Name_Runtime_Project : constant Name_Id := N + 701;
- Name_Shared_Library_Minimum_Options : constant Name_Id := N + 702;
- Name_Shared_Library_Prefix : constant Name_Id := N + 703;
- Name_Shared_Library_Suffix : constant Name_Id := N + 704;
- Name_Separate_Suffix : constant Name_Id := N + 705;
- Name_Source_Dirs : constant Name_Id := N + 706;
- Name_Source_Files : constant Name_Id := N + 707;
- Name_Source_List_File : constant Name_Id := N + 708;
- Name_Spec : constant Name_Id := N + 709;
- Name_Spec_Suffix : constant Name_Id := N + 710;
- Name_Specification : constant Name_Id := N + 711;
- 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;
+ Name_Ada_Roots : constant Name_Id := N + 613;
+ Name_Archive_Builder : constant Name_Id := N + 614;
+ Name_Archive_Indexer : constant Name_Id := N + 615;
+ Name_Archive_Suffix : constant Name_Id := N + 616;
+ Name_Binder : constant Name_Id := N + 617;
+ Name_Binder_Prefix : constant Name_Id := N + 618;
+ Name_Body_Suffix : constant Name_Id := N + 619;
+ Name_Builder : constant Name_Id := N + 620;
+ Name_Builder_Switches : constant Name_Id := N + 621;
+ Name_Compiler : constant Name_Id := N + 622;
+ Name_Compiler_Kind : constant Name_Id := N + 623;
+ Name_Config_Body_File_Name : constant Name_Id := N + 624;
+ Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 625;
+ Name_Config_File_Switches : constant Name_Id := N + 626;
+ Name_Config_File_Unique : constant Name_Id := N + 627;
+ Name_Config_Spec_File_Name : constant Name_Id := N + 628;
+ Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 629;
+ Name_Cross_Reference : constant Name_Id := N + 630;
+ Name_Default_Language : constant Name_Id := N + 631;
+ Name_Default_Switches : constant Name_Id := N + 632;
+ Name_Dependency_Driver : constant Name_Id := N + 633;
+ Name_Dependency_File_Kind : constant Name_Id := N + 634;
+ Name_Dependency_Switches : constant Name_Id := N + 635;
+ Name_Driver : constant Name_Id := N + 636;
+ Name_Exec_Dir : constant Name_Id := N + 637;
+ Name_Executable : constant Name_Id := N + 638;
+ Name_Executable_Suffix : constant Name_Id := N + 639;
+ Name_Extends : constant Name_Id := N + 640;
+ Name_Externally_Built : constant Name_Id := N + 641;
+ Name_Finder : constant Name_Id := N + 642;
+ Name_Global_Configuration_Pragmas : constant Name_Id := N + 643;
+ Name_Global_Config_File : constant Name_Id := N + 644;
+ Name_Gnatls : constant Name_Id := N + 645;
+ Name_Gnatstub : constant Name_Id := N + 646;
+ Name_Implementation : constant Name_Id := N + 647;
+ Name_Implementation_Exceptions : constant Name_Id := N + 648;
+ Name_Implementation_Suffix : constant Name_Id := N + 649;
+ Name_Include_Option : constant Name_Id := N + 650;
+ Name_Include_Path : constant Name_Id := N + 651;
+ Name_Include_Path_File : constant Name_Id := N + 652;
+ Name_Language_Kind : constant Name_Id := N + 653;
+ Name_Language_Processing : constant Name_Id := N + 654;
+ Name_Languages : constant Name_Id := N + 655;
+ Name_Library_Ali_Dir : constant Name_Id := N + 656;
+ Name_Library_Auto_Init : constant Name_Id := N + 657;
+ Name_Library_Auto_Init_Supported : constant Name_Id := N + 658;
+ Name_Library_Builder : constant Name_Id := N + 659;
+ Name_Library_Dir : constant Name_Id := N + 660;
+ Name_Library_GCC : constant Name_Id := N + 661;
+ Name_Library_Interface : constant Name_Id := N + 662;
+ Name_Library_Kind : constant Name_Id := N + 663;
+ Name_Library_Name : constant Name_Id := N + 664;
+ Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 665;
+ Name_Library_Options : constant Name_Id := N + 666;
+ Name_Library_Partial_Linker : constant Name_Id := N + 667;
+ Name_Library_Reference_Symbol_File : constant Name_Id := N + 668;
+ Name_Library_Src_Dir : constant Name_Id := N + 669;
+ Name_Library_Support : constant Name_Id := N + 670;
+ Name_Library_Symbol_File : constant Name_Id := N + 671;
+ Name_Library_Symbol_Policy : constant Name_Id := N + 672;
+ Name_Library_Version : constant Name_Id := N + 673;
+ Name_Library_Version_Switches : constant Name_Id := N + 674;
+ Name_Linker : constant Name_Id := N + 675;
+ Name_Linker_Executable_Option : constant Name_Id := N + 676;
+ Name_Linker_Lib_Dir_Option : constant Name_Id := N + 677;
+ Name_Linker_Lib_Name_Option : constant Name_Id := N + 678;
+ Name_Local_Config_File : constant Name_Id := N + 679;
+ Name_Local_Configuration_Pragmas : constant Name_Id := N + 680;
+ Name_Locally_Removed_Files : constant Name_Id := N + 681;
+ Name_Mapping_File_Switches : constant Name_Id := N + 682;
+ Name_Mapping_Spec_Suffix : constant Name_Id := N + 683;
+ Name_Mapping_Body_Suffix : constant Name_Id := N + 684;
+ Name_Metrics : constant Name_Id := N + 685;
+ Name_Naming : constant Name_Id := N + 686;
+ Name_Objects_Path : constant Name_Id := N + 687;
+ Name_Objects_Path_File : constant Name_Id := N + 688;
+ Name_Object_Dir : constant Name_Id := N + 689;
+ Name_Pic_Option : constant Name_Id := N + 690;
+ Name_Pretty_Printer : constant Name_Id := N + 691;
+ Name_Prefix : constant Name_Id := N + 692;
+ Name_Project : constant Name_Id := N + 693;
+ Name_Roots : constant Name_Id := N + 694;
+ Name_Required_Switches : constant Name_Id := N + 695;
+ Name_Run_Path_Option : constant Name_Id := N + 696;
+ Name_Runtime_Project : constant Name_Id := N + 697;
+ Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 698;
+ Name_Shared_Library_Prefix : constant Name_Id := N + 699;
+ Name_Shared_Library_Suffix : constant Name_Id := N + 700;
+ Name_Separate_Suffix : constant Name_Id := N + 701;
+ Name_Source_Dirs : constant Name_Id := N + 702;
+ Name_Source_Files : constant Name_Id := N + 703;
+ Name_Source_List_File : constant Name_Id := N + 704;
+ Name_Spec : constant Name_Id := N + 705;
+ Name_Spec_Suffix : constant Name_Id := N + 706;
+ Name_Specification : constant Name_Id := N + 707;
+ Name_Specification_Exceptions : constant Name_Id := N + 708;
+ Name_Specification_Suffix : constant Name_Id := N + 709;
+ Name_Stack : constant Name_Id := N + 710;
+ Name_Switches : constant Name_Id := N + 711;
+ Name_Symbolic_Link_Supported : constant Name_Id := N + 712;
+ Name_Toolchain_Description : constant Name_Id := N + 713;
+ Name_Toolchain_Version : constant Name_Id := N + 714;
-- 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
- First_2005_Reserved_Word : constant Name_Id := N + 720;
- Name_Interface : constant Name_Id := N + 720;
- Name_Overriding : constant Name_Id := N + 721;
- Name_Synchronized : constant Name_Id := N + 722;
- Last_2005_Reserved_Word : constant Name_Id := N + 722;
+ First_2005_Reserved_Word : constant Name_Id := N + 716;
+ Name_Interface : constant Name_Id := N + 716;
+ Name_Overriding : constant Name_Id := N + 717;
+ Name_Synchronized : constant Name_Id := N + 718;
+ Last_2005_Reserved_Word : constant Name_Id := N + 718;
subtype Ada_2005_Reserved_Words is
Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
-- 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 --
Attribute_Digits,
Attribute_Elaborated,
Attribute_Emax,
+ Attribute_Enabled,
Attribute_Enum_Rep,
Attribute_Epsilon,
Attribute_Exponent,
Pragma_Ada_2005,
Pragma_Assertion_Policy,
Pragma_C_Pass_By_Copy,
+ Pragma_Check_Name,
Pragma_Compile_Time_Error,
Pragma_Compile_Time_Warning,
Pragma_Component_Alignment,
Pragma_Extensions_Allowed,
Pragma_External_Name_Casing,
Pragma_Float_Representation,
+ Pragma_Implicit_Packing,
Pragma_Initialize_Scalars,
Pragma_Interrupt_State,
Pragma_License,
-- Test to see if the name N is the name of a recognized type attribute,
-- 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;
-- Test to see if the name N is the name of one of the recognized
-- language conventions, as required by pragma Convention, Import,
-- Returns the name of language convention correspoding to given
-- 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;
-- 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.
pragma Inline (Is_Attribute_Name);
pragma Inline (Is_Entity_Attribute_Name);
pragma Inline (Is_Type_Attribute_Name);
- pragma Inline (Is_Check_Name);
pragma Inline (Is_Locking_Policy_Name);
pragma Inline (Is_Operator_Symbol_Name);
pragma Inline (Is_Queuing_Policy_Name);
#define Attr_Digits 24
#define Attr_Elaborated 25
#define Attr_Emax 26
-#define Attr_Enum_Rep 27
-#define Attr_Epsilon 28
-#define Attr_Exponent 29
-#define Attr_External_Tag 30
-#define Attr_First 31
-#define Attr_First_Bit 32
-#define Attr_Fixed_Value 33
-#define Attr_Fore 34
-#define Attr_Has_Access_Values 35
-#define Attr_Has_Discriminants 36
-#define Attr_Identity 37
-#define Attr_Img 38
-#define Attr_Integer_Value 39
-#define Attr_Large 40
-#define Attr_Last 41
-#define Attr_Last_Bit 42
-#define Attr_Leading_Part 43
-#define Attr_Length 44
-#define Attr_Machine_Emax 45
-#define Attr_Machine_Emin 46
-#define Attr_Machine_Mantissa 47
-#define Attr_Machine_Overflows 48
-#define Attr_Machine_Radix 49
-#define Attr_Machine_Rounding 50
-#define Attr_Machine_Rounds 51
-#define Attr_Machine_Size 52
-#define Attr_Mantissa 53
-#define Attr_Max_Size_In_Storage_Elements 54
-#define Attr_Maximum_Alignment 55
-#define Attr_Mechanism_Code 56
-#define Attr_Mod 57
-#define Attr_Model_Emin 58
-#define Attr_Model_Epsilon 59
-#define Attr_Model_Mantissa 60
-#define Attr_Model_Small 61
-#define Attr_Modulus 62
-#define Attr_Null_Parameter 63
-#define Attr_Object_Size 64
-#define Attr_Partition_ID 65
-#define Attr_Passed_By_Reference 66
-#define Attr_Pool_Address 67
-#define Attr_Pos 68
-#define Attr_Position 69
-#define Attr_Priority 70
-#define Attr_Range 71
-#define Attr_Range_Length 72
-#define Attr_Round 73
-#define Attr_Safe_Emax 74
-#define Attr_Safe_First 75
-#define Attr_Safe_Large 76
-#define Attr_Safe_Last 77
-#define Attr_Safe_Small 78
-#define Attr_Scale 79
-#define Attr_Scaling 80
-#define Attr_Signed_Zeros 81
-#define Attr_Size 82
-#define Attr_Small 83
-#define Attr_Storage_Size 84
-#define Attr_Storage_Unit 85
-#define Attr_Stream_Size 86
-#define Attr_Tag 87
-#define Attr_Target_Name 88
-#define Attr_Terminated 89
-#define Attr_To_Address 90
-#define Attr_Type_Class 91
-#define Attr_UET_Address 92
-#define Attr_Unbiased_Rounding 93
-#define Attr_Unchecked_Access 94
-#define Attr_Unconstrained_Array 95
-#define Attr_Universal_Literal_String 96
-#define Attr_Unrestricted_Access 97
-#define Attr_VADS_Size 98
-#define Attr_Val 99
-#define Attr_Valid 100
-#define Attr_Value_Size 101
-#define Attr_Version 102
-#define Attr_Wchar_T_Size 103
-#define Attr_Wide_Wide_Width 104
-#define Attr_Wide_Width 105
-#define Attr_Width 106
-#define Attr_Word_Size 107
-#define Attr_Adjacent 108
-#define Attr_Ceiling 109
-#define Attr_Copy_Sign 110
-#define Attr_Floor 111
-#define Attr_Fraction 112
-#define Attr_Image 113
-#define Attr_Input 114
-#define Attr_Machine 115
-#define Attr_Max 116
-#define Attr_Min 117
-#define Attr_Model 118
-#define Attr_Pred 119
-#define Attr_Remainder 120
-#define Attr_Rounding 121
-#define Attr_Succ 122
-#define Attr_Truncation 123
-#define Attr_Value 124
-#define Attr_Wide_Image 125
-#define Attr_Wide_Wide_Image 126
-#define Attr_Wide_Value 127
-#define Attr_Wide_Wide_Value 128
-#define Attr_Output 129
-#define Attr_Read 130
-#define Attr_Write 131
-#define Attr_Elab_Body 132
-#define Attr_Elab_Spec 133
-#define Attr_Storage_Pool 134
-#define Attr_Base 135
-#define Attr_Class 136
-#define Attr_Stub_Type 137
+#define Attr_Enabled 27
+#define Attr_Enum_Rep 28
+#define Attr_Epsilon 29
+#define Attr_Exponent 30
+#define Attr_External_Tag 31
+#define Attr_First 32
+#define Attr_First_Bit 33
+#define Attr_Fixed_Value 34
+#define Attr_Fore 35
+#define Attr_Has_Access_Values 36
+#define Attr_Has_Discriminants 37
+#define Attr_Identity 38
+#define Attr_Img 39
+#define Attr_Integer_Value 40
+#define Attr_Large 41
+#define Attr_Last 42
+#define Attr_Last_Bit 43
+#define Attr_Leading_Part 44
+#define Attr_Length 45
+#define Attr_Machine_Emax 46
+#define Attr_Machine_Emin 47
+#define Attr_Machine_Mantissa 48
+#define Attr_Machine_Overflows 49
+#define Attr_Machine_Radix 50
+#define Attr_Machine_Rounding 51
+#define Attr_Machine_Rounds 52
+#define Attr_Machine_Size 53
+#define Attr_Mantissa 54
+#define Attr_Max_Size_In_Storage_Elements 55
+#define Attr_Maximum_Alignment 56
+#define Attr_Mechanism_Code 57
+#define Attr_Mod 58
+#define Attr_Model_Emin 59
+#define Attr_Model_Epsilon 60
+#define Attr_Model_Mantissa 61
+#define Attr_Model_Small 62
+#define Attr_Modulus 63
+#define Attr_Null_Parameter 64
+#define Attr_Object_Size 65
+#define Attr_Partition_ID 66
+#define Attr_Passed_By_Reference 67
+#define Attr_Pool_Address 68
+#define Attr_Pos 69
+#define Attr_Position 70
+#define Attr_Priority 71
+#define Attr_Range 72
+#define Attr_Range_Length 73
+#define Attr_Round 74
+#define Attr_Safe_Emax 75
+#define Attr_Safe_First 76
+#define Attr_Safe_Large 77
+#define Attr_Safe_Last 78
+#define Attr_Safe_Small 79
+#define Attr_Scale 80
+#define Attr_Scaling 81
+#define Attr_Signed_Zeros 82
+#define Attr_Size 83
+#define Attr_Small 84
+#define Attr_Storage_Size 85
+#define Attr_Storage_Unit 86
+#define Attr_Stream_Size 87
+#define Attr_Tag 88
+#define Attr_Target_Name 89
+#define Attr_Terminated 90
+#define Attr_To_Address 91
+#define Attr_Type_Class 92
+#define Attr_UET_Address 93
+#define Attr_Unbiased_Rounding 94
+#define Attr_Unchecked_Access 95
+#define Attr_Unconstrained_Array 96
+#define Attr_Universal_Literal_String 97
+#define Attr_Unrestricted_Access 98
+#define Attr_VADS_Size 99
+#define Attr_Val 100
+#define Attr_Valid 101
+#define Attr_Value_Size 102
+#define Attr_Version 103
+#define Attr_Wchar_T_Size 104
+#define Attr_Wide_Wide_Width 105
+#define Attr_Wide_Width 106
+#define Attr_Width 107
+#define Attr_Word_Size 108
+#define Attr_Adjacent 109
+#define Attr_Ceiling 110
+#define Attr_Copy_Sign 111
+#define Attr_Floor 112
+#define Attr_Fraction 113
+#define Attr_Image 114
+#define Attr_Input 115
+#define Attr_Machine 116
+#define Attr_Max 117
+#define Attr_Min 118
+#define Attr_Model 119
+#define Attr_Pred 120
+#define Attr_Remainder 121
+#define Attr_Rounding 122
+#define Attr_Succ 123
+#define Attr_Truncation 124
+#define Attr_Value 125
+#define Attr_Wide_Image 126
+#define Attr_Wide_Wide_Image 127
+#define Attr_Wide_Value 128
+#define Attr_Wide_Wide_Value 129
+#define Attr_Output 130
+#define Attr_Read 131
+#define Attr_Write 132
+#define Attr_Elab_Body 133
+#define Attr_Elab_Spec 134
+#define Attr_Storage_Pool 135
+#define Attr_Base 136
+#define Attr_Class 137
+#define Attr_Stub_Type 138
/* Define the numeric values for the conventions. */
#define Pragma_Ada_2005 3
#define Pragma_Assertion_Policy 4
#define Pragma_C_Pass_By_Copy 5
-#define Pragma_Compile_Time_Error 6
-#define Pragma_Compile_Time_Warning 7
-#define Pragma_Component_Alignment 8
-#define Pragma_Convention_Identifier 9
-#define Pragma_Debug_Policy 10
-#define Pragma_Detect_Blocking 11
-#define Pragma_Discard_Names 12
-#define Pragma_Elaboration_Checks 13
-#define Pragma_Eliminate 14
-#define Pragma_Extend_System 15
-#define Pragma_Extensions_Allowed 16
-#define Pragma_External_Name_Casing 17
-#define Pragma_Float_Representation 18
-#define Pragma_Initialize_Scalars 19
-#define Pragma_Interrupt_State 20
-#define Pragma_License 21
-#define Pragma_Locking_Policy 22
-#define Pragma_Long_Float 23
-#define Pragma_No_Run_Time 24
-#define Pragma_No_Strict_Aliasing 25
-#define Pragma_Normalize_Scalars 26
-#define Pragma_Polling 27
-#define Pragma_Persistent_BSS 28
-#define Pragma_Priority_Specific_Dispatching 29
-#define Pragma_Profile 30
-#define Pragma_Profile_Warnings 31
-#define Pragma_Propagate_Exceptions 32
-#define Pragma_Queuing_Policy 33
-#define Pragma_Ravenscar 34
-#define Pragma_Restricted_Run_Time 35
-#define Pragma_Restrictions 36
-#define Pragma_Restriction_Warnings 37
-#define Pragma_Reviewable 38
-#define Pragma_Source_File_Name 39
-#define Pragma_Source_File_Name_Project 40
-#define Pragma_Style_Checks 41
-#define Pragma_Suppress 42
-#define Pragma_Suppress_Exception_Locations 43
-#define Pragma_Task_Dispatching_Policy 44
-#define Pragma_Universal_Data 45
-#define Pragma_Unsuppress 46
-#define Pragma_Use_VADS_Size 47
-#define Pragma_Validity_Checks 48
-#define Pragma_Warnings 49
-#define Pragma_Wide_Character_Encoding 50
-#define Pragma_Abort_Defer 51
-#define Pragma_All_Calls_Remote 52
-#define Pragma_Annotate 53
-#define Pragma_Assert 54
-#define Pragma_Asynchronous 55
-#define Pragma_Atomic 56
-#define Pragma_Atomic_Components 57
-#define Pragma_Attach_Handler 58
-#define Pragma_CIL_Constructor 59
-#define Pragma_Comment 60
-#define Pragma_Common_Object 61
-#define Pragma_Complete_Representation 62
-#define Pragma_Complex_Representation 63
-#define Pragma_Controlled 64
-#define Pragma_Convention 65
-#define Pragma_CPP_Class 66
-#define Pragma_CPP_Constructor 67
-#define Pragma_CPP_Virtual 68
-#define Pragma_CPP_Vtable 69
-#define Pragma_Debug 70
-#define Pragma_Elaborate 71
-#define Pragma_Elaborate_All 72
-#define Pragma_Elaborate_Body 73
-#define Pragma_Export 74
-#define Pragma_Export_Exception 75
-#define Pragma_Export_Function 76
-#define Pragma_Export_Object 77
-#define Pragma_Export_Procedure 78
-#define Pragma_Export_Value 79
-#define Pragma_Export_Valued_Procedure 80
-#define Pragma_External 81
-#define Pragma_Finalize_Storage_Only 82
-#define Pragma_Ident 83
-#define Pragma_Import 84
-#define Pragma_Import_Exception 85
-#define Pragma_Import_Function 86
-#define Pragma_Import_Object 87
-#define Pragma_Import_Procedure 88
-#define Pragma_Import_Valued_Procedure 89
-#define Pragma_Inline 90
-#define Pragma_Inline_Always 91
-#define Pragma_Inline_Generic 92
-#define Pragma_Inspection_Point 93
-#define Pragma_Interface_Name 94
-#define Pragma_Interrupt_Handler 95
-#define Pragma_Interrupt_Priority 96
-#define Pragma_Java_Constructor 97
-#define Pragma_Java_Interface 98
-#define Pragma_Keep_Names 99
-#define Pragma_Link_With 100
-#define Pragma_Linker_Alias 101
-#define Pragma_Linker_Constructor 102
-#define Pragma_Linker_Destructor 103
-#define Pragma_Linker_Options 104
-#define Pragma_Linker_Section 105
-#define Pragma_List 106
-#define Pragma_Machine_Attribute 107
-#define Pragma_Main 108
-#define Pragma_Main_Storage 109
-#define Pragma_Memory_Size 110
-#define Pragma_No_Body 111
-#define Pragma_No_Return 112
-#define Pragma_Obsolescent 113
-#define Pragma_Optimize 114
-#define Pragma_Pack 115
-#define Pragma_Page 116
-#define Pragma_Passive 117
-#define Pragma_Preelaborable_Initialization 118
-#define Pragma_Preelaborate 119
-#define Pragma_Preelaborate_05 120
-#define Pragma_Psect_Object 121
-#define Pragma_Pure 122
-#define Pragma_Pure_05 123
-#define Pragma_Pure_Function 124
-#define Pragma_Remote_Call_Interface 125
-#define Pragma_Remote_Types 126
-#define Pragma_Share_Generic 127
-#define Pragma_Shared 128
-#define Pragma_Shared_Passive 129
-#define Pragma_Source_Reference 130
-#define Pragma_Static_Elaboration_Desired 131
-#define Pragma_Stream_Convert 132
-#define Pragma_Subtitle 133
-#define Pragma_Suppress_All 134
-#define Pragma_Suppress_Debug_Info 135
-#define Pragma_Suppress_Initialization 136
-#define Pragma_System_Name 137
-#define Pragma_Task_Info 138
-#define Pragma_Task_Name 139
-#define Pragma_Task_Storage 140
-#define Pragma_Time_Slice 141
-#define Pragma_Title 142
-#define Pragma_Unchecked_Union 143
-#define Pragma_Unimplemented_Unit 144
-#define Pragma_Universal_Aliasing 145
-#define Pragma_Unreferenced 146
-#define Pragma_Unreferenced_Objects 147
-#define Pragma_Unreserve_All_Interrupts 148
-#define Pragma_Volatile 149
-#define Pragma_Volatile_Components 150
-#define Pragma_Weak_External 151
-#define Pragma_AST_Entry 152
-#define Pragma_Interface 153
-#define Pragma_Priority 154
-#define Pragma_Storage_Size 155
-#define Pragma_Storage_Unit 156
+#define Pragma_Check_Name 6
+#define Pragma_Compile_Time_Error 7
+#define Pragma_Compile_Time_Warning 8
+#define Pragma_Component_Alignment 9
+#define Pragma_Convention_Identifier 10
+#define Pragma_Debug_Policy 11
+#define Pragma_Detect_Blocking 12
+#define Pragma_Discard_Names 13
+#define Pragma_Elaboration_Checks 14
+#define Pragma_Eliminate 15
+#define Pragma_Extend_System 16
+#define Pragma_Extensions_Allowed 17
+#define Pragma_External_Name_Casing 18
+#define Pragma_Float_Representation 19
+#define Pragma_Implicit_Packing 20
+#define Pragma_Initialize_Scalars 21
+#define Pragma_Interrupt_State 22
+#define Pragma_License 23
+#define Pragma_Locking_Policy 24
+#define Pragma_Long_Float 25
+#define Pragma_No_Run_Time 26
+#define Pragma_No_Strict_Aliasing 27
+#define Pragma_Normalize_Scalars 28
+#define Pragma_Polling 29
+#define Pragma_Persistent_BSS 30
+#define Pragma_Priority_Specific_Dispatching 31
+#define Pragma_Profile 32
+#define Pragma_Profile_Warnings 33
+#define Pragma_Propagate_Exceptions 34
+#define Pragma_Queuing_Policy 35
+#define Pragma_Ravenscar 36
+#define Pragma_Restricted_Run_Time 37
+#define Pragma_Restrictions 38
+#define Pragma_Restriction_Warnings 39
+#define Pragma_Reviewable 40
+#define Pragma_Source_File_Name 41
+#define Pragma_Source_File_Name_Project 42
+#define Pragma_Style_Checks 43
+#define Pragma_Suppress 44
+#define Pragma_Suppress_Exception_Locations 45
+#define Pragma_Task_Dispatching_Policy 46
+#define Pragma_Universal_Data 47
+#define Pragma_Unsuppress 48
+#define Pragma_Use_VADS_Size 49
+#define Pragma_Validity_Checks 50
+#define Pragma_Warnings 51
+#define Pragma_Wide_Character_Encoding 52
+#define Pragma_Abort_Defer 53
+#define Pragma_All_Calls_Remote 54
+#define Pragma_Annotate 55
+#define Pragma_Assert 56
+#define Pragma_Asynchronous 57
+#define Pragma_Atomic 58
+#define Pragma_Atomic_Components 59
+#define Pragma_Attach_Handler 60
+#define Pragma_CIL_Constructor 61
+#define Pragma_Comment 62
+#define Pragma_Common_Object 63
+#define Pragma_Complete_Representation 64
+#define Pragma_Complex_Representation 65
+#define Pragma_Controlled 66
+#define Pragma_Convention 67
+#define Pragma_CPP_Class 68
+#define Pragma_CPP_Constructor 69
+#define Pragma_CPP_Virtual 70
+#define Pragma_CPP_Vtable 71
+#define Pragma_Debug 72
+#define Pragma_Elaborate 73
+#define Pragma_Elaborate_All 74
+#define Pragma_Elaborate_Body 75
+#define Pragma_Export 76
+#define Pragma_Export_Exception 77
+#define Pragma_Export_Function 78
+#define Pragma_Export_Object 79
+#define Pragma_Export_Procedure 80
+#define Pragma_Export_Value 81
+#define Pragma_Export_Valued_Procedure 82
+#define Pragma_External 83
+#define Pragma_Finalize_Storage_Only 84
+#define Pragma_Ident 85
+#define Pragma_Import 86
+#define Pragma_Import_Exception 87
+#define Pragma_Import_Function 88
+#define Pragma_Import_Object 89
+#define Pragma_Import_Procedure 90
+#define Pragma_Import_Valued_Procedure 91
+#define Pragma_Inline 92
+#define Pragma_Inline_Always 93
+#define Pragma_Inline_Generic 94
+#define Pragma_Inspection_Point 95
+#define Pragma_Interface_Name 96
+#define Pragma_Interrupt_Handler 97
+#define Pragma_Interrupt_Priority 98
+#define Pragma_Java_Constructor 99
+#define Pragma_Java_Interface 100
+#define Pragma_Keep_Names 101
+#define Pragma_Link_With 102
+#define Pragma_Linker_Alias 103
+#define Pragma_Linker_Constructor 104
+#define Pragma_Linker_Destructor 105
+#define Pragma_Linker_Options 106
+#define Pragma_Linker_Section 107
+#define Pragma_List 108
+#define Pragma_Machine_Attribute 109
+#define Pragma_Main 110
+#define Pragma_Main_Storage 111
+#define Pragma_Memory_Size 112
+#define Pragma_No_Body 113
+#define Pragma_No_Return 114
+#define Pragma_Obsolescent 115
+#define Pragma_Optimize 116
+#define Pragma_Pack 117
+#define Pragma_Page 118
+#define Pragma_Passive 119
+#define Pragma_Preelaborable_Initialization 120
+#define Pragma_Preelaborate 121
+#define Pragma_Preelaborate_05 122
+#define Pragma_Psect_Object 123
+#define Pragma_Pure 124
+#define Pragma_Pure_05 125
+#define Pragma_Pure_Function 126
+#define Pragma_Remote_Call_Interface 127
+#define Pragma_Remote_Types 128
+#define Pragma_Share_Generic 129
+#define Pragma_Shared 130
+#define Pragma_Shared_Passive 131
+#define Pragma_Source_Reference 132
+#define Pragma_Static_Elaboration_Desired 133
+#define Pragma_Stream_Convert 134
+#define Pragma_Subtitle 135
+#define Pragma_Suppress_All 136
+#define Pragma_Suppress_Debug_Info 137
+#define Pragma_Suppress_Initialization 138
+#define Pragma_System_Name 139
+#define Pragma_Task_Info 140
+#define Pragma_Task_Name 141
+#define Pragma_Task_Storage 142
+#define Pragma_Time_Slice 143
+#define Pragma_Title 144
+#define Pragma_Unchecked_Union 145
+#define Pragma_Unimplemented_Unit 146
+#define Pragma_Universal_Aliasing 147
+#define Pragma_Unreferenced 148
+#define Pragma_Unreferenced_Objects 149
+#define Pragma_Unreserve_All_Interrupts 150
+#define Pragma_Volatile 151
+#define Pragma_Volatile_Components 152
+#define Pragma_Weak_External 153
+#define Pragma_AST_Entry 154
+#define Pragma_Interface 155
+#define Pragma_Priority 156
+#define Pragma_Storage_Size 157
+#define Pragma_Storage_Unit 158
/* End of snames.h (C version of Snames package spec) */
projects / platform / upstream / linaro-gcc.git / commitdiff