diff options
| author | Vincent Celier <celier@adacore.com> | 2007-08-14 10:39:33 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2007-08-14 10:39:33 +0200 |
| commit | ede007da18026bf6153ce5d86de81e147760b763 (patch) | |
| tree | 42154a73ebb6b14dd56ca33611abdbb14e1ac2ef /gcc | |
| parent | 86cde7b14709c9ac4e599dfd16402d4145e80a05 (diff) | |
| download | gcc-ede007da18026bf6153ce5d86de81e147760b763.zip gcc-ede007da18026bf6153ce5d86de81e147760b763.tar.gz gcc-ede007da18026bf6153ce5d86de81e147760b763.tar.bz2 | |
prj.ads, prj.adb: Update Project Manager to new attribute names for gprbuild.
2007-08-14 Vincent Celier <celier@adacore.com>
* prj.ads, prj.adb: Update Project Manager to new attribute names for
gprbuild.
Allow all valid declarations in configuration project files
(Reset): Initialize all tables and hash tables in the project tree data
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
(Slash_Id): Change type to be Path_Name_Type
(Slash): Return a Path_Name_Type instead of a File_Name_Type
* prj-attr.ads, prj-attr.adb: Remove attributes no longer used by
gprbuild.
Update Project Manager to new attribute names for ghprbuild
Allow all valid declarations in configuration project files
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
* prj-com.ads:
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
* prj-dect.adb (Prj.Strt.Attribute_Reference): Set correctly the case
insensitive flag for attributes with optional index.
(Prj.Dect.Parse_Attribute_Declaration): For case insensitive associative
array attribute, put the index in lower case.
Update Project Manager to new attribute names for ghprbuild
Allow all valid declarations in configuration project files
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
* prj-env.ads, prj-env.adb:
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
(Get_Reference): Change type of parameter Path to Path_Name_Type
* prj-ext.ads, prj-ext.adb (Initialize_Project_Path): Make sure, after
removing '-' from the path to start with the first character of the
next directory.
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
* prj-nmsc.ads, prj-nmsc.adb:
Update Project Manager to new attribute names for ghprbuild
Allow all valid declarations in configuration project files
(Search_Directories): Detect subunits that are specified with an
attribute Body in package Naming. Do not replace a source/unit in the
same project when the order of the source dirs are known. Detect
duplicate sources/units in the same project when the order of the
source dirs are not known.
(Check_Ada_Name): Allow all identifiers that are not reserved words
in Ada 95.
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
(Look_For_Sources): If the list of sources is empty, set the object
directory of non extending project to nil.
Change type of path name variables to be Path_Name_Type
(Locate_Directory): Make sure that on Windows '/' is converted to '\',
otherwise creating missing directories will fail.
* prj-attr-pm.adb, prj-tree.ads, prj-proc.ads, prj-proc.adb,
prj-part.ads, prj-part.adb:
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
* prj-strt.adb (Prj.Strt.Attribute_Reference): Set correctly the case
insensitive flag for attributes with optional index.
(Prj.Dect.Parse_Attribute_Declaration): For case insensitive associative
array attribute, put the index in lower case.
(Parse_Variable_Reference): Allow the current project name to be used in
the prefix of an attribute reference.
* prj-util.ads, prj-util.adb
(Value_Of (for arrays)): New Boolean parameter Force_Lower_Case_Index,
defaulted to False. When True, always check against indexes in lower
case.
* snames.ads, snames.h, snames.adb:
Update Project Manager to new attribute names for gprbuild
Allow all valid declarations in configuration project files
From-SVN: r127420
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/prj-attr-pm.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.adb | 333 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.ads | 35 | ||||
| -rw-r--r-- | gcc/ada/prj-com.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/prj-dect.adb | 49 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 428 | ||||
| -rw-r--r-- | gcc/ada/prj-env.ads | 20 | ||||
| -rw-r--r-- | gcc/ada/prj-ext.adb | 63 | ||||
| -rw-r--r-- | gcc/ada/prj-ext.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 4009 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/prj-pars.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/prj-pars.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 209 | ||||
| -rw-r--r-- | gcc/ada/prj-part.ads | 25 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 644 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/prj-strt.adb | 118 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/prj-util.adb | 223 | ||||
| -rw-r--r-- | gcc/ada/prj-util.ads | 23 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 826 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 1329 | ||||
| -rw-r--r-- | gcc/ada/snames.adb | 45 | ||||
| -rw-r--r-- | gcc/ada/snames.ads | 1269 | ||||
| -rw-r--r-- | gcc/ada/snames.h | 527 |
26 files changed, 7500 insertions, 2738 deletions
diff --git a/gcc/ada/prj-attr-pm.adb b/gcc/ada/prj-attr-pm.adb index 21bd566..b974333 100644 --- a/gcc/ada/prj-attr-pm.adb +++ b/gcc/ada/prj-attr-pm.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -45,6 +45,7 @@ package body Prj.Attr.PM is 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 := @@ -62,7 +63,9 @@ package body Prj.Attr.PM is 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; diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 244e228..ca207ff 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -32,11 +32,11 @@ package body Prj.Attr is -- 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 @@ -52,161 +52,242 @@ package body Prj.Attr is -- 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 @@ -274,10 +355,11 @@ package body Prj.Attr is 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 @@ -342,9 +424,9 @@ package body Prj.Attr is 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' => @@ -402,6 +484,15 @@ package body Prj.Attr is 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 @@ -441,6 +532,7 @@ package body Prj.Attr is Var_Kind => Var_Kind, Optional_Index => Optional_Index, Attr_Kind => Attr_Kind, + Read_Only => Read_Only, Next => Empty_Attr); Start := Finish + 1; end if; @@ -449,6 +541,15 @@ package body Prj.Attr is 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 -- ---------------- @@ -582,6 +683,7 @@ package body Prj.Attr is 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; @@ -615,7 +717,9 @@ package body Prj.Attr is 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 @@ -682,13 +786,16 @@ package body Prj.Attr is 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; --------------------------- diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads index abd5511..ce4ff4c 100644 --- a/gcc/ada/prj-attr.ads +++ b/gcc/ada/prj-attr.ads @@ -153,6 +153,8 @@ package Prj.Attr is -- 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 @@ -269,18 +271,18 @@ private 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 -------------- @@ -288,20 +290,19 @@ private -------------- 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; diff --git a/gcc/ada/prj-com.ads b/gcc/ada/prj-com.ads index c7a96aa..3dcdfb4 100644 --- a/gcc/ada/prj-com.ads +++ b/gcc/ada/prj-com.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -24,10 +24,8 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 13889a4..139175c 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -24,14 +24,17 @@ -- -- ------------------------------------------------------------------------------ -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 @@ -214,11 +217,19 @@ 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 @@ -272,7 +283,13 @@ package body Prj.Dect is 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 @@ -996,6 +1013,10 @@ package body Prj.Dect is 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" @@ -1130,7 +1151,7 @@ package body Prj.Dect is 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 @@ -1251,13 +1272,13 @@ package body Prj.Dect is 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 := diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 589a98b..80d1b9f 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -35,15 +35,16 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; 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 @@ -69,13 +70,13 @@ package body Prj.Env is ----------------------- 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. @@ -88,13 +89,14 @@ package body Prj.Env is 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; @@ -105,13 +107,6 @@ package body Prj.Env is 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 @@ -329,8 +324,7 @@ package body Prj.Env is ------------------------ 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 @@ -491,7 +485,7 @@ package body Prj.Env is -- 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; @@ -503,7 +497,7 @@ package body Prj.Env is (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 @@ -517,7 +511,8 @@ package body Prj.Env is ----------------------- 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); @@ -525,18 +520,18 @@ package body Prj.Env is -- 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 @@ -581,7 +576,7 @@ package body Prj.Env is 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; @@ -629,7 +624,7 @@ package body Prj.Env is 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; @@ -731,7 +726,7 @@ package body Prj.Env is (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 => " & @@ -747,7 +742,7 @@ package body Prj.Env is (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 => " & @@ -759,8 +754,8 @@ package body Prj.Env is -- 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"); @@ -810,10 +805,15 @@ package body Prj.Env is 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; @@ -1117,10 +1117,14 @@ package body Prj.Env is 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 @@ -1162,6 +1166,164 @@ package body Prj.Env is 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 -- -------------------------- @@ -1175,9 +1337,10 @@ package body Prj.Env is 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 @@ -1238,17 +1401,17 @@ package body Prj.Env is 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); @@ -1281,9 +1444,9 @@ package body Prj.Env is 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 @@ -1317,9 +1480,9 @@ package body Prj.Env is -- 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"); @@ -1336,7 +1499,7 @@ package body Prj.Env is -- 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; @@ -1380,9 +1543,9 @@ package body Prj.Env is -- 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"); @@ -1398,7 +1561,7 @@ package body Prj.Env is -- 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; @@ -1446,9 +1609,9 @@ package body Prj.Env is 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 -- @@ -1464,10 +1627,8 @@ package body Prj.Env is -- 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); @@ -1497,7 +1658,8 @@ package body Prj.Env is -- 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 @@ -1507,8 +1669,7 @@ package body Prj.Env is 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); @@ -1532,8 +1693,7 @@ package body Prj.Env is -- 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; @@ -1549,25 +1709,28 @@ package body Prj.Env is 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); @@ -1590,18 +1753,19 @@ package body Prj.Env is 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; @@ -1614,9 +1778,12 @@ package body Prj.Env is -- 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; @@ -1653,7 +1820,7 @@ package body Prj.Env is (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 ??? @@ -1680,10 +1847,10 @@ package body Prj.Env is 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 @@ -1702,7 +1869,7 @@ package body Prj.Env is 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) @@ -1723,7 +1890,7 @@ package body Prj.Env is end; Project := No_Project; - Path := No_File; + Path := No_Path; if Current_Verbosity > Default then Write_Str ("Cannot be found."); @@ -1756,14 +1923,14 @@ package body Prj.Env is 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 @@ -1786,7 +1953,6 @@ package body Prj.Env is 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 @@ -1947,14 +2113,14 @@ package body Prj.Env is 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; @@ -1963,8 +2129,6 @@ package body Prj.Env is 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; @@ -1997,7 +2161,7 @@ package body Prj.Env is -- 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 @@ -2015,7 +2179,7 @@ package body Prj.Env is -- 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 @@ -2092,11 +2256,11 @@ package body Prj.Env is 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; @@ -2105,8 +2269,8 @@ package body Prj.Env is 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 @@ -2114,10 +2278,10 @@ package body Prj.Env is 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 @@ -2131,21 +2295,17 @@ package body Prj.Env is 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; @@ -2347,21 +2507,21 @@ package body Prj.Env is ----------------------- 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 diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index a3a3db7..74bb9fc 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -44,6 +44,16 @@ package Prj.Env is -- 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. @@ -61,6 +71,14 @@ package Prj.Env is -- 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; @@ -135,7 +153,7 @@ package Prj.Env is (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 diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 4ab0a90..557f11c 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -29,14 +29,14 @@ with Makeutl; use Makeutl; 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. @@ -67,6 +67,7 @@ package body Prj.Ext is -- 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, @@ -76,7 +77,6 @@ package body Prj.Ext is Table_Name => "Prj.Ext.Search_Directories"); -- The table for the directories specified with -aP switches - --------- -- Add -- --------- @@ -97,6 +97,7 @@ package body Prj.Ext is Htable.Set (The_Key, The_Value); end Add; + ----------- ---------------------------------- -- Add_Search_Project_Directory -- ---------------------------------- @@ -108,7 +109,6 @@ package body Prj.Ext is Search_Directories.Append (Name_Find); end Add_Search_Project_Directory; - ----------- -- Check -- ----------- @@ -140,28 +140,22 @@ package body Prj.Ext is 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; @@ -179,9 +173,9 @@ package body Prj.Ext is (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; @@ -223,6 +217,11 @@ package body Prj.Ext is 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 @@ -264,9 +263,19 @@ package body Prj.Ext is 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 @@ -278,7 +287,9 @@ package body Prj.Ext is ".." & 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; diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads index c8ffaef..551984b 100644 --- a/gcc/ada/prj-ext.ads +++ b/gcc/ada/prj-ext.ads @@ -29,6 +29,10 @@ 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 diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 0bb83a5..b742c01 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -24,10 +24,14 @@ -- -- ------------------------------------------------------------------------------ +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; @@ -45,12 +49,13 @@ with Ada.Strings; use Ada.Strings; 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 @@ -67,6 +72,8 @@ package body Prj.Nmsc is 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 @@ -76,6 +83,8 @@ package body Prj.Nmsc is 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 @@ -93,7 +102,7 @@ package body Prj.Nmsc is (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 @@ -148,15 +157,21 @@ package body Prj.Nmsc is -- 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); @@ -168,9 +183,15 @@ package body Prj.Nmsc is 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; @@ -190,9 +211,9 @@ package body Prj.Nmsc is -- 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. @@ -204,7 +225,9 @@ package body Prj.Nmsc is -- 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. @@ -229,14 +252,6 @@ package body Prj.Nmsc is -- 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; @@ -246,6 +261,13 @@ package body Prj.Nmsc is -- 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; @@ -281,7 +303,8 @@ package body Prj.Nmsc is -- 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; @@ -328,8 +351,8 @@ package body Prj.Nmsc is 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; @@ -347,7 +370,7 @@ package body Prj.Nmsc is 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; @@ -368,14 +391,23 @@ package body Prj.Nmsc is -- When Naming_Exceptions is True, mark the found sources as such, to -- later remove those that are not named in a list of sources. - procedure 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 @@ -394,6 +426,45 @@ package body Prj.Nmsc is -- 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 -- ------------------- @@ -429,60 +500,119 @@ package body Prj.Nmsc is 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); + + 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; - -- Check that all individual naming conventions apply to sources of - -- this project file. + 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 @@ -495,6 +625,33 @@ package body Prj.Nmsc is 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; @@ -534,12 +691,17 @@ package body Prj.Nmsc is 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; @@ -651,13 +813,11 @@ package body Prj.Nmsc is 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 @@ -700,24 +860,28 @@ package body Prj.Nmsc is 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 @@ -743,7 +907,7 @@ package body Prj.Nmsc is """) cannot end with" & " Spec_Suffix (""" & Spec_Suffix & """).", - Naming.Body_Suffix_Loc); + Naming.Ada_Body_Suffix_Loc); end if; if Body_Suffix /= Separate_Suffix @@ -767,13 +931,386 @@ package body Prj.Nmsc is 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; @@ -1084,34 +1621,38 @@ package body Prj.Nmsc is 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); @@ -1127,8 +1668,7 @@ package body Prj.Nmsc is 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.", @@ -1149,266 +1689,843 @@ package body Prj.Nmsc is 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; - if not Dot_Replacement.Default then - Get_Name_String (Dot_Replacement.Value); + Get_Name_String (Element.Index); + To_Lower (Name_Buffer (1 .. Name_Len)); + Unit := Name_Find; - if Name_Len = 0 then + Index := Element.Value.Index; + + -- 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 - -- Check Separate_Suffix + declare + Casing_String : constant Variable_Value := + Util.Value_Of + (Name_Casing, + Naming.Decl.Attributes, + In_Tree); - 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 + pragma Assert (Casing_String.Kind = Single, + "Casing is not a single string"); - begin - if Ada_Sep_Suffix.Default then - Data.Naming.Separate_Suffix := - Data.Naming.Ada_Body_Suffix; + 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; - else - Get_Name_String (Ada_Sep_Suffix.Value); + exception + when Constraint_Error => + if Casing_Image'Length = 0 then + Error_Msg + (Project, In_Tree, + "Casing cannot be an empty string", + Casing_String.Location); - if Name_Len = 0 then - Error_Msg - (Project, In_Tree, - "Separate_Suffix cannot be empty", - Ada_Sep_Suffix.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; + end; + + 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 -- @@ -1441,6 +2558,83 @@ package body Prj.Nmsc is 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 @@ -1452,8 +2646,7 @@ package body Prj.Nmsc is 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 @@ -1469,9 +2662,6 @@ package body Prj.Nmsc is Data.Location); end if; end if; - - In_Tree.Projects.Table (Data.Extends).Library := - False; end if; end; end if; @@ -1493,7 +2683,7 @@ package body Prj.Nmsc is 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 @@ -1506,8 +2696,7 @@ package body Prj.Nmsc is 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); @@ -1517,7 +2706,8 @@ package body Prj.Nmsc is 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; @@ -1557,9 +2747,7 @@ package body Prj.Nmsc is 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 @@ -1627,7 +2815,7 @@ package body Prj.Nmsc is 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; @@ -1635,10 +2823,10 @@ package body Prj.Nmsc is 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 = """); @@ -1648,10 +2836,18 @@ package body Prj.Nmsc is 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", @@ -1780,8 +2976,7 @@ package body Prj.Nmsc is 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 := @@ -1830,7 +3025,7 @@ package body Prj.Nmsc is 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); @@ -1873,7 +3068,7 @@ package body Prj.Nmsc is 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, @@ -1885,12 +3080,33 @@ package body Prj.Nmsc is 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; -------------------------- @@ -2018,7 +3234,7 @@ package body Prj.Nmsc is -- 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; @@ -2105,10 +3321,12 @@ package body Prj.Nmsc is --------------------------------- 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 := @@ -2123,58 +3341,239 @@ package body Prj.Nmsc is if Languages.Default then -- Attribute Languages is not specified. So, it defaults to - -- a project of language Ada only. + -- a project of the default language only. - Data.Languages (Ada_Language_Index) := True; + Name_List_Table.Increment_Last (In_Tree.Name_Lists); + Data.Languages := Name_List_Table.Last (In_Tree.Name_Lists); - -- No sources of languages other than Ada + -- In Ada_Only mode, the default language is Ada - Data.Other_Sources_Present := False; + 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; - Index : Language_Index; + 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 - -- Assume that there is no language specified yet + if Get_Mode = Ada_Only then + -- Assume that there is no language specified yet - Data.Other_Sources_Present := False; - Data.Ada_Sources_Present := False; + Data.Other_Sources_Present := False; + Data.Ada_Sources_Present := False; + end if; - -- Look through all the languages specified in attribute - -- Languages, if any + -- If there are no languages declared, there are no sources - 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; + if Current = Nil_String then + Data.Source_Dirs := Nil_String; - Set (Index, True, Data, In_Tree); - Set (Language_Processing => Default_Language_Processing_Data, - For_Language => Index, - In_Project => Data, - In_Tree => In_Tree); + else + -- Look through all the languages specified in attribute + -- Languages. - if Index = Ada_Language_Index then - Data.Ada_Sources_Present := True; + 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; - else - Data.Other_Sources_Present := True; - end if; + Name_List_Table.Increment_Last (In_Tree.Name_Lists); - Current := Element.Next; - end loop; + if NL_Id = No_Name_List then + Data.Languages := + Name_List_Table.Last (In_Tree.Name_Lists); + + else + In_Tree.Name_Lists.Table (NL_Id).Next := + Name_List_Table.Last (In_Tree.Name_Lists); + end if; + + NL_Id := Name_List_Table.Last (In_Tree.Name_Lists); + In_Tree.Name_Lists.Table (NL_Id) := + (Lang_Name, No_Name_List); + + if Get_Mode = Ada_Only then + Index := Language_Indexes.Get (Lang_Name); + + if Index = No_Language_Index then + Add_Language_Name (Lang_Name); + Index := Last_Language_Index; + end if; + + 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 = Ada_Language_Index then + Data.Ada_Sources_Present := True; + + else + Data.Other_Sources_Present := True; + end if; + + else + Index := Data.First_Language_Processing; + + 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 + 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); + + 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 + 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; + end if; end; end if; end if; @@ -2258,13 +3657,22 @@ package body Prj.Nmsc is 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 @@ -2275,7 +3683,7 @@ package body Prj.Nmsc is 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); @@ -2290,11 +3698,9 @@ package body Prj.Nmsc is 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; @@ -2302,19 +3708,17 @@ package body Prj.Nmsc is 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; @@ -2339,81 +3743,105 @@ package body Prj.Nmsc is 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); + + else + -- Check that the unit is part of the project - The_Unit_Data := - In_Tree.Units.Table (The_Unit_Id); + The_Unit_Data := + In_Tree.Units.Table (The_Unit_Id); - 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) + if The_Unit_Data.File_Names (Body_Part).Name /= No_File + and then The_Unit_Data.File_Names (Body_Part).Path /= + Slash then - -- There is a body for this unit. - -- If there is no spec, we need to check - -- that it is not a subunit. - - if The_Unit_Data.File_Names (Specification).Name = - No_File + 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 @@ -2422,31 +3850,91 @@ package body Prj.Nmsc is 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; - Add_ALI_For - (The_Unit_Data.File_Names (Specification).Name); + 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; + + 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; @@ -2520,7 +4008,7 @@ package body Prj.Nmsc is 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 @@ -2554,7 +4042,7 @@ package body Prj.Nmsc is 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 @@ -2593,7 +4081,7 @@ package body Prj.Nmsc is -- 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, @@ -2625,7 +4113,7 @@ package body Prj.Nmsc is -- 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); @@ -2686,9 +4174,6 @@ package body Prj.Nmsc is 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, @@ -2699,7 +4184,7 @@ package body Prj.Nmsc is 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 @@ -2710,15 +4195,11 @@ package body Prj.Nmsc is 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); @@ -2727,41 +4208,38 @@ package body Prj.Nmsc is (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, @@ -2772,7 +4250,8 @@ package body Prj.Nmsc is 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); @@ -2783,28 +4262,43 @@ package body Prj.Nmsc is 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, @@ -2822,34 +4316,6 @@ package body Prj.Nmsc is 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; @@ -2871,25 +4337,6 @@ package body Prj.Nmsc is 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 -- --------------- @@ -3043,6 +4490,130 @@ package body Prj.Nmsc is 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; + + Source_Dir := Element.Next; + end loop; + + 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 -- ------------------ @@ -3113,7 +4684,7 @@ package body Prj.Nmsc is (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; @@ -3186,7 +4757,7 @@ package body Prj.Nmsc is 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; @@ -3223,14 +4794,17 @@ package body Prj.Nmsc is 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 -- @@ -3259,8 +4833,8 @@ package body Prj.Nmsc is 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)) & @@ -3296,7 +4870,7 @@ package body Prj.Nmsc is 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; @@ -3314,12 +4888,12 @@ package body Prj.Nmsc is 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 @@ -3334,14 +4908,16 @@ package body Prj.Nmsc is 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 @@ -3439,8 +5015,8 @@ package body Prj.Nmsc is 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); @@ -3511,8 +5087,8 @@ package body Prj.Nmsc is 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); @@ -3532,14 +5108,16 @@ package body Prj.Nmsc is 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; @@ -3586,13 +5164,17 @@ package body Prj.Nmsc is 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 @@ -3637,7 +5219,8 @@ package body Prj.Nmsc is 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, @@ -3650,8 +5233,7 @@ package body Prj.Nmsc is 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", @@ -3678,7 +5260,18 @@ package body Prj.Nmsc is 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 @@ -3716,8 +5309,6 @@ package body Prj.Nmsc is end if; Data.Source_Dirs := Nil_String; - Data.Ada_Sources_Present := False; - Data.Other_Sources_Present := False; else declare @@ -3729,7 +5320,8 @@ package body Prj.Nmsc is -- 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; @@ -3758,6 +5350,7 @@ package body Prj.Nmsc is Current := Element.Next; end loop; end; + end Get_Directories; --------------- @@ -3780,7 +5373,8 @@ package body Prj.Nmsc is 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 @@ -3807,9 +5401,12 @@ package body Prj.Nmsc is 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 """); @@ -3840,12 +5437,18 @@ package body Prj.Nmsc is 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; @@ -3859,7 +5462,8 @@ package body Prj.Nmsc is -------------- 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; @@ -3907,12 +5511,13 @@ package body Prj.Nmsc is 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) = @@ -3929,7 +5534,7 @@ package body Prj.Nmsc is 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 @@ -3947,7 +5552,9 @@ package body Prj.Nmsc is 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 @@ -4188,17 +5795,25 @@ package body Prj.Nmsc is 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); @@ -4288,11 +5903,19 @@ package body Prj.Nmsc is -- 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 -- --------------------------------------- @@ -4300,7 +5923,7 @@ package body Prj.Nmsc is 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; @@ -4386,7 +6009,8 @@ package body Prj.Nmsc is 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; @@ -4434,20 +6058,692 @@ package body Prj.Nmsc is 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/warning. + -- We should have found at least one source. + -- If not, report an error. - if Data.Sources = Nil_String then - Report_No_Ada_Sources (Project, In_Tree, Location); + if Data.Ada_Sources = Nil_String then + Report_No_Sources (Project, "Ada", In_Tree, Location); + end if; + + 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 @@ -4498,32 +6794,51 @@ package body Prj.Nmsc is 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. - Get_Path_Names_And_Record_Sources (Follow_Links); + 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); + end if; end; -- No source_files specified @@ -4532,8 +6847,8 @@ package body Prj.Nmsc is 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 := @@ -4546,7 +6861,6 @@ package body Prj.Nmsc is 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", @@ -4564,16 +6878,17 @@ package body Prj.Nmsc is -- 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; @@ -4582,7 +6897,6 @@ package body Prj.Nmsc is Extended : Project_Id; begin - Current := Locally_Removed.Values; while Current /= Nil_String loop Element := In_Tree.String_Elements.Table (Current); @@ -4613,7 +6927,8 @@ package body Prj.Nmsc is -- 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) @@ -4674,8 +6989,7 @@ package body Prj.Nmsc is 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. @@ -4742,6 +7056,8 @@ package body Prj.Nmsc is (File_Id, (Name => File_Id, Location => Element.Location, + Source => No_Source, + Except => False, Found => False)); end if; @@ -4836,6 +7152,8 @@ package body Prj.Nmsc is E => (Name => Name, Location => Location, + Source => No_Source, + Except => False, Found => False)); Current := Element.Next; @@ -4910,6 +7228,237 @@ package body Prj.Nmsc is 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; ------------------ @@ -4918,17 +7467,18 @@ package body Prj.Nmsc is 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 ""; @@ -4960,13 +7510,12 @@ package body Prj.Nmsc is 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; @@ -5008,7 +7557,7 @@ package body Prj.Nmsc is 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; @@ -5018,12 +7567,12 @@ package body Prj.Nmsc is 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; @@ -5053,10 +7602,12 @@ package body Prj.Nmsc is 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, @@ -5105,14 +7656,15 @@ package body Prj.Nmsc is 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)) := @@ -5121,25 +7673,27 @@ package body Prj.Nmsc is 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 @@ -5153,13 +7707,13 @@ package body Prj.Nmsc is -- only the other unit kind (spec or body), or what is -- in the unit list is a unit of a project we are extending. - if The_Unit /= 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, @@ -5175,17 +7729,20 @@ package body Prj.Nmsc is 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 @@ -5194,6 +7751,7 @@ package body Prj.Nmsc is 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 @@ -5210,7 +7768,8 @@ package body Prj.Nmsc is 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; @@ -5221,17 +7780,19 @@ package body Prj.Nmsc is 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 @@ -5250,7 +7811,8 @@ package body Prj.Nmsc is 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 %%", @@ -5259,20 +7821,24 @@ package body Prj.Nmsc is 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; @@ -5297,7 +7863,7 @@ package body Prj.Nmsc is 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); @@ -5305,7 +7871,8 @@ package body Prj.Nmsc is 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; @@ -5460,14 +8027,123 @@ package body Prj.Nmsc is 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 @@ -5476,20 +8152,19 @@ package body Prj.Nmsc 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; @@ -5498,7 +8173,7 @@ package body Prj.Nmsc is 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 (" "); @@ -5569,7 +8244,7 @@ package body Prj.Nmsc is 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; @@ -5580,10 +8255,12 @@ package body Prj.Nmsc is 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 %%", diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads index 7918ea1..59ba9c8 100644 --- a/gcc/ada/prj-nmsc.ads +++ b/gcc/ada/prj-nmsc.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -59,7 +59,7 @@ private package Prj.Nmsc is -- 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; diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb index 0b8e34e..e09ffc8 100644 --- a/gcc/ada/prj-pars.adb +++ b/gcc/ada/prj-pars.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -32,6 +32,7 @@ with Prj.Err; use Prj.Err; with Prj.Part; with Prj.Proc; with Prj.Tree; use Prj.Tree; +with Sinput.P; package body Prj.Pars is @@ -44,7 +45,8 @@ 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; @@ -57,6 +59,7 @@ package body Prj.Pars is -- Parse the main project file into a tree + Sinput.P.Reset_First; Prj.Part.Parse (In_Tree => Project_Node_Tree, Project => Project_Node, @@ -75,7 +78,8 @@ package body Prj.Pars is 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 diff --git a/gcc/ada/prj-pars.ads b/gcc/ada/prj-pars.ads index 237a934..840b121 100644 --- a/gcc/ada/prj-pars.ads +++ b/gcc/ada/prj-pars.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -36,7 +36,8 @@ package 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); -- Parse a project files and all its imported project files, in the -- project tree In_Tree. -- @@ -50,5 +51,8 @@ package Prj.Pars is -- -- 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; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index f58e59f..19e41b7 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -37,24 +37,19 @@ with Sinput.P; use Sinput.P; 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 -- @@ -64,7 +59,7 @@ package body Prj.Part is 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; @@ -88,7 +83,6 @@ package body Prj.Part is 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, @@ -159,28 +153,13 @@ package body Prj.Part is 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; @@ -193,7 +172,7 @@ package body Prj.Part is -- 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. @@ -349,7 +328,8 @@ package body Prj.Part is ---------------------------- 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); @@ -474,7 +454,7 @@ package body Prj.Part is 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; @@ -508,7 +488,8 @@ package body Prj.Part is 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 @@ -640,6 +621,13 @@ package body Prj.Part is 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"); @@ -659,7 +647,7 @@ package body Prj.Part is -- 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, @@ -714,9 +702,10 @@ package body Prj.Part is 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; @@ -732,7 +721,6 @@ package body Prj.Part is 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; @@ -760,7 +748,8 @@ package body Prj.Part is -- 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, @@ -837,7 +826,8 @@ package body Prj.Part is 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); @@ -895,7 +885,8 @@ package body Prj.Part is 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; @@ -905,14 +896,13 @@ package body Prj.Part is 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; @@ -949,21 +939,21 @@ package body Prj.Part is 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; @@ -1060,14 +1050,22 @@ package body Prj.Part is 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 @@ -1121,7 +1119,7 @@ package body Prj.Part is 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; @@ -1136,6 +1134,11 @@ package body Prj.Part is 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; @@ -1178,17 +1181,27 @@ package body Prj.Part is 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; @@ -1217,15 +1230,15 @@ package body Prj.Part is 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 @@ -1246,10 +1259,10 @@ package body Prj.Part is 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 @@ -1273,7 +1286,9 @@ package body Prj.Part is 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 := @@ -1290,23 +1305,24 @@ package body Prj.Part is -- 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; @@ -1327,7 +1343,8 @@ package body Prj.Part is 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 @@ -1360,9 +1377,8 @@ package body Prj.Part is 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; @@ -1395,7 +1411,7 @@ package body Prj.Part is 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); @@ -1405,7 +1421,7 @@ package body Prj.Part is 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, @@ -1414,7 +1430,7 @@ package body Prj.Part is 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; @@ -1422,8 +1438,8 @@ package body Prj.Part is 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; @@ -1547,7 +1563,7 @@ package body Prj.Part is -- 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; @@ -1563,7 +1579,7 @@ package body Prj.Part is -- 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); @@ -1580,8 +1596,13 @@ package body Prj.Part is -- 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 @@ -1598,13 +1619,13 @@ package body Prj.Part is 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; @@ -1612,7 +1633,7 @@ package body Prj.Part is -- 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 @@ -1627,7 +1648,7 @@ package body Prj.Part is loop if not Is_Letter (Name_Buffer (Index)) then - return No_File; + return No_Name; else loop @@ -1637,7 +1658,7 @@ package body Prj.Part is if Name_Buffer (Index) = '_' then if Name_Buffer (Index + 1) = '_' then - return No_File; + return No_Name; end if; end if; @@ -1646,7 +1667,7 @@ package body Prj.Part is if Name_Buffer (Index) /= '_' and then not Is_Alphanumeric (Name_Buffer (Index)) then - return No_File; + return No_Name; end if; end loop; @@ -1660,7 +1681,7 @@ package body Prj.Part is return Name_Find; else - return No_File; + return No_Name; end if; elsif Name_Buffer (Index) = '-' then diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads index 38f8d81..10d0390 100644 --- a/gcc/ada/prj-part.ads +++ b/gcc/ada/prj-part.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -46,4 +46,27 @@ package Prj.Part is -- 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; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index fe279f9..78870d6 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -32,6 +32,7 @@ with Prj.Attr; use Prj.Attr; 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; @@ -51,21 +52,32 @@ package body Prj.Proc is 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 @@ -166,10 +178,12 @@ package body Prj.Proc is -------------------- 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; @@ -200,6 +214,15 @@ package body Prj.Proc is 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 => @@ -235,7 +258,7 @@ package body Prj.Proc is procedure Check (In_Tree : Project_Tree_Ref; - Project : in out Project_Id; + Project : Project_Id; Follow_Links : Boolean; When_No_Sources : Error_Warning) is @@ -248,7 +271,39 @@ package body Prj.Proc 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; ------------------------------- @@ -567,10 +622,10 @@ package body Prj.Proc is 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 @@ -580,7 +635,7 @@ package body Prj.Proc is 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 @@ -590,7 +645,6 @@ package body Prj.Proc is The_Name := Name_Of (Term_Project, From_Project_Node_Tree); - The_Project := Imported_Or_Extended_Project_From (Project => Project, In_Tree => In_Tree, @@ -603,7 +657,6 @@ package body Prj.Proc is The_Name := Name_Of (Term_Package, From_Project_Node_Tree); - The_Package := In_Tree.Projects.Table (The_Project).Decl.Packages; @@ -1140,23 +1193,307 @@ package body Prj.Proc is 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, @@ -1165,110 +1502,152 @@ package body Prj.Proc is 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 := @@ -1289,12 +1668,15 @@ package body Prj.Proc is 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 @@ -1313,6 +1695,7 @@ package body Prj.Proc is case Kind_Of (Current_Item, From_Project_Node_Tree) is when N_Package_Declaration => + -- Do not process a package declaration that should be ignored if Expression_Kind_Of @@ -1400,11 +1783,14 @@ package body Prj.Proc is -- 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 @@ -1444,7 +1830,7 @@ package body Prj.Proc is 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; @@ -1534,10 +1920,10 @@ package body Prj.Proc is -- 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 @@ -1745,7 +2131,7 @@ package body Prj.Proc is if Error_Report = null then Error_Msg - ("no value defined for %", + ("no value defined for %%", Location_Of (Current_Item, From_Project_Node_Tree)); @@ -1791,8 +2177,8 @@ package body Prj.Proc is 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)); @@ -1805,10 +2191,6 @@ package body Prj.Proc is 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; @@ -2414,8 +2796,7 @@ package body Prj.Proc is 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; @@ -2423,10 +2804,15 @@ package body Prj.Proc is 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; diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index ec38405..99560f5 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -40,7 +40,8 @@ package Prj.Proc is 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. @@ -53,6 +54,9 @@ package Prj.Proc is -- 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; diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index c5a6992..c90e008 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -45,6 +45,7 @@ package body Prj.Strt is 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; @@ -211,8 +212,9 @@ package body Prj.Strt is (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 @@ -321,7 +323,8 @@ package body Prj.Strt is 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)); @@ -390,15 +393,10 @@ package body Prj.Strt is 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 @@ -423,10 +421,8 @@ package body Prj.Strt is 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 => @@ -477,16 +473,19 @@ package body Prj.Strt is 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; @@ -509,6 +508,7 @@ package body Prj.Strt is -- 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. @@ -606,6 +606,7 @@ package body Prj.Strt is 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; @@ -705,12 +706,21 @@ package body Prj.Strt is -- 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; @@ -719,15 +729,15 @@ package body Prj.Strt is 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); @@ -797,8 +807,16 @@ package body Prj.Strt is -- 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. @@ -811,12 +829,18 @@ package body Prj.Strt is -- 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; @@ -881,7 +905,7 @@ package body Prj.Strt is case Names.Last is when 0 => - -- Cannot happen + -- Cannot happen (so why null instead of raise PE???) null; @@ -990,16 +1014,18 @@ package body Prj.Strt is -- 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 @@ -1018,7 +1044,8 @@ package body Prj.Strt is 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 %", @@ -1041,7 +1068,6 @@ package body Prj.Strt is if Specified_Project /= Empty_Node then The_Project := Specified_Project; - else The_Project := Current_Project; end if; @@ -1056,7 +1082,6 @@ package body Prj.Strt is 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 @@ -1074,7 +1099,6 @@ package body Prj.Strt is 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 @@ -1088,7 +1112,6 @@ package body Prj.Strt is 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 @@ -1112,8 +1135,8 @@ package body Prj.Strt is (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, @@ -1151,7 +1174,7 @@ package body Prj.Strt is 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 @@ -1161,11 +1184,10 @@ package body Prj.Strt is 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); @@ -1176,7 +1198,6 @@ package body Prj.Strt is Choice_Lasts.Increment_Last; Choice_Lasts.Table (Choice_Lasts.Last) := Choices.Last; - end Start_New_Case_Construction; ----------- @@ -1249,8 +1270,7 @@ package body Prj.Strt is 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; @@ -1387,7 +1407,7 @@ package body Prj.Strt is 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; @@ -1420,6 +1440,7 @@ package body Prj.Strt is end if; when Tok_External => + -- An external reference is always a single string if Expr_Kind = Undefined then @@ -1442,10 +1463,7 @@ package body Prj.Strt is -- 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, diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index 470e0a8..b0a9bd6 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -29,6 +29,8 @@ with GNAT.Dynamic_HTables; with GNAT.Dynamic_Tables; +with Table; + with Prj.Attr; use Prj.Attr; package Prj.Tree is @@ -196,8 +198,11 @@ 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; @@ -1206,7 +1211,8 @@ package Prj.Tree is -- 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 diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index 4c00ac4..a49e9a8 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -26,7 +26,7 @@ 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; @@ -56,6 +56,38 @@ package body Prj.Util is 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 -- ----------------- @@ -101,23 +133,34 @@ package body Prj.Util is 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); @@ -130,14 +173,6 @@ package body Prj.Util is 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 @@ -186,13 +221,11 @@ package body Prj.Util is 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; @@ -205,21 +238,21 @@ package body Prj.Util is -- 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 @@ -242,9 +275,20 @@ package body Prj.Util is 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; @@ -348,8 +392,10 @@ package body Prj.Util is 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; @@ -366,6 +412,52 @@ package body Prj.Util is 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 -- -------------- @@ -386,15 +478,17 @@ package body Prj.Util is 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; @@ -423,23 +517,28 @@ package body Prj.Util is 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; @@ -465,7 +564,8 @@ package body Prj.Util is 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; @@ -482,10 +582,11 @@ package body Prj.Util is 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 @@ -508,10 +609,11 @@ package body Prj.Util is 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 @@ -530,10 +632,11 @@ package body Prj.Util is 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); @@ -552,10 +655,11 @@ package body Prj.Util is 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 @@ -571,10 +675,11 @@ package body Prj.Util is 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); diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads index 4163f98..ffb606e 100644 --- a/gcc/ada/prj-util.ads +++ b/gcc/ada/prj-util.ads @@ -40,6 +40,17 @@ package Prj.Util is -- 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; @@ -58,10 +69,11 @@ package Prj.Util is -- 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. -- @@ -75,7 +87,8 @@ package Prj.Util is 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 diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index ea7807b..2d0866c 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -26,6 +26,7 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; +with Debug; with Output; use Output; with Osint; use Osint; with Prj.Attr; @@ -34,21 +35,28 @@ with Prj.Err; use Prj.Err; 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; @@ -63,29 +71,27 @@ package body Prj is 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, @@ -104,22 +110,24 @@ package body Prj is 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, @@ -130,27 +138,45 @@ package body Prj is 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 -- @@ -183,7 +209,8 @@ package body Prj is 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); @@ -196,6 +223,124 @@ package body Prj is 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 -- ----------------------------- @@ -214,6 +359,70 @@ package body Prj is 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 -- --------------------------- @@ -225,16 +434,31 @@ package body Prj is 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; @@ -258,6 +482,38 @@ package body Prj is 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 -- -------------------------------- @@ -278,7 +534,6 @@ package body Prj is 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; @@ -305,16 +560,30 @@ package body Prj is 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; @@ -328,6 +597,15 @@ package body Prj is return The_Casing_Images (Casing).all; end Image; + ---------------------- + -- In_Configuration -- + ---------------------- + + function In_Configuration return Boolean is + begin + return Configuration_Mode; + end In_Configuration; + ---------------- -- Initialize -- ---------------- @@ -353,10 +631,6 @@ package body Prj is 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)); @@ -376,6 +650,84 @@ package body Prj is 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 -- ---------------- @@ -391,7 +743,7 @@ package body Prj is return False; when First_Language_Indexes => - return In_Project.Languages (Language); + return In_Project.Langs (Language); when others => declare @@ -429,7 +781,7 @@ package body Prj is 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 @@ -453,6 +805,62 @@ package body Prj is 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 -- ------------------------------------ @@ -463,9 +871,9 @@ package body Prj is 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 @@ -508,12 +916,10 @@ package body Prj is 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; @@ -566,36 +972,60 @@ package body Prj is ----------- procedure Reset (Tree : Project_Tree_Ref) is + + -- Def_Lang : constant Name_Node := + -- (Name => Name_Ada, + -- Next => No_Name_List); + -- Why is the above commented out ??? + begin 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; ------------------------ @@ -608,8 +1038,6 @@ package body Prj is 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; @@ -629,7 +1057,7 @@ package body Prj is null; when First_Language_Indexes => - In_Project.Languages (Language) := Present; + In_Project.Langs (Language) := Present; when others => declare @@ -675,16 +1103,16 @@ package body Prj is 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); @@ -755,15 +1183,216 @@ package body Prj is 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 -- -------------------------- @@ -820,6 +1449,40 @@ package body Prj is 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 -- ----------- @@ -836,8 +1499,9 @@ package body Prj is 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; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 1b2e358..47bc052 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -44,6 +44,31 @@ with System.HTable; 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. @@ -57,21 +82,23 @@ package Prj is 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 @@ -83,18 +110,535 @@ package Prj is -- - 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 "" + + type Project_Id is new Nat; + No_Project : constant Project_Id := 0; + -- Id of a Project File + + 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). + + 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 + + type Variable_Kind is (Undefined, List, Single); + -- Different kinds of variables + + subtype Defined_Variable_Kind is Variable_Kind range List .. Single; + -- The defined kinds of variables + + Ignored : constant Variable_Kind; + -- Used to indicate that a package declaration must be ignored + -- while processing the project tree (unknown package name). + + 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 + + Nil_Variable_Value : constant Variable_Value; + -- Value of a non existing variable or array element + + 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 + + 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 - ----------------------------------------------------- - -- Multi-language Stuff That Will be Modified Soon -- - ----------------------------------------------------- + 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. - -- Still should be properly commented ??? + 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 + + 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. + + 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 + + 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. + + 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 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 Package_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Package_Element, + Table_Index_Type => Package_Id, + Table_Low_Bound => 1, + Table_Initial => 100, + Table_Increment => 100); + -- The table that contains all packages type Language_Index is new Nat; - No_Language_Index : constant Language_Index := 0; + No_Language_Index : constant Language_Index := 0; + + procedure Display_Language_Name + (In_Tree : Project_Tree_Ref; + Language : Language_Index); + + type Header_Num is range 0 .. 2047; + + 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; + + type Name_Node is record + Name : Name_Id := No_Name; + 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_Low_Bound => 1, + Table_Initial => 10, + Table_Increment => 100); + -- The table for lists of names used in package Language_Processing + + 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 + + type Lang_Naming_Data is record + Dot_Replacement : File_Name_Type := No_File; + -- The string to replace '.' in the source file name (for Ada) + + Casing : Casing_Type := All_Lower_Case; + -- The casing of the source file name (for Ada) + + Separate_Suffix : File_Name_Type := No_File; + -- String to append to unit name for source file name of an Ada subunit + + Spec_Suffix : File_Name_Type := No_File; + -- The string to append to the unit name for the + -- source file name of a spec. + + Body_Suffix : File_Name_Type := No_File; + -- The string to append to the unit name for the + -- source file name of a body. + end record; + + 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 => 10, + Table_Increment => 100); + -- The table for lists of names used in package Language_Processing + + type Alternate_Language_Id is new Nat; + + No_Alternate_Language : constant Alternate_Language_Id := 0; + + type Alternate_Language_Data is record + Language : Language_Index := No_Language_Index; + Next : Alternate_Language_Id := No_Alternate_Language; + end record; + + 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 => 10, + Table_Increment => 100); + -- 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; + + 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 + -- Default is default (very quiet, if no errors). + -- Medium is more verbose. + -- High is extremely verbose. + + Current_Verbosity : Verbosity := Default; + -- The current value of the verbosity the project files are parsed with + + type Lib_Kind is (Static, Dynamic, Relocatable); + + type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct); + -- Type to specify the symbol policy, when symbol control is supported. + -- See full explanation about this type in package Symbols. + -- Autonomous: Create a symbol file without considering any reference + -- Compliant: Try to be as compatible as possible with an existing ref + -- Controlled: Fail if symbols are not the same as those in the reference + -- Restricted: Restrict the symbols to those in the symbol file + -- Direct: The symbol file is used as is + + type Symbol_Record is record + 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_Path, + Reference => No_Path, + Symbol_Policy => Autonomous); + -- The default value of the symbol data + + function Image (Casing : Casing_Type) return String; + -- Similar to 'Image (but avoid use of this attribute in compiler) + + 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. + + -- Declarations for gprmake: + First_Language_Index : constant Language_Index := 1; First_Language_Indexes_Last : constant Language_Index := 5; @@ -110,13 +654,6 @@ package Prj is subtype First_Language_Indexes is Language_Index range First_Language_Index .. First_Language_Indexes_Last; - type Header_Num is range 0 .. 2047; - - 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; - package Language_Indexes is new System.HTable.Simple_HTable (Header_Num => Header_Num, Element => Language_Index, @@ -185,28 +722,12 @@ package Prj is -- The table for the presence of languages with an index that is outside -- of First_Language_Indexes. - type Language_Kind is (GNU, other); - - type Name_List_Index is new Nat; - No_Name_List : constant Name_List_Index := 0; - - type Name_Node is record - Name : Name_Id := No_Name; - Next : Name_List_Index := No_Name_List; - end record; - - package Name_List_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Name_Node, - Table_Index_Type => Name_List_Index, - Table_Low_Bound => 1, - Table_Initial => 10, - Table_Increment => 100); - -- The table for lists of names used in package Language_Processing + 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 : Language_Kind := GNU; + 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; @@ -274,198 +795,6 @@ package Prj is Table_Increment => 100); -- The table for sources of languages other than Ada - ---------------------------------- - -- End of multi-language stuff -- - ---------------------------------- - - type Verbosity is (Default, Medium, High); - -- Verbosity when parsing GNAT Project Files - -- Default is default (very quiet, if no errors). - -- Medium is more verbose. - -- High is extremely verbose. - - Current_Verbosity : Verbosity := Default; - -- The current value of the verbosity the project files are parsed with - - type Lib_Kind is (Static, Dynamic, Relocatable); - type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct); - -- Type to specify the symbol policy, when symbol control is supported. - -- See full explanation about this type in package Symbols. - -- Autonomous: Create a symbol file without considering any reference - -- Compliant: Try to be as compatible as possible with an existing ref - -- Controlled: Fail if symbols are not the same as those in the reference - -- Restricted: Restrict the symbols to those in the symbol file - -- 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_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_Policy => Autonomous); - -- The default value of the symbol data - - function Empty_String return Name_Id; - -- Return the Name_Id for an empty string "" - - type Project_Id is new Nat; - No_Project : constant Project_Id := 0; - -- Id of a Project File - - 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). - - 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 - - type Variable_Kind is (Undefined, List, Single); - -- Different kinds of variables - - subtype Defined_Variable_Kind is Variable_Kind range List .. Single; - -- The defined kinds of variables - - Ignored : constant Variable_Kind; - -- Used to indicate that a package declaration must be ignored - -- while processing the project tree (unknown package name). - - 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 - - Nil_Variable_Value : constant Variable_Value; - -- Value of a non existing variable or array element - - 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 - - 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 - - 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 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 - - 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. - - 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 - - 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. - - 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 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 Package_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Package_Element, - Table_Index_Type => Package_Id, - Table_Low_Bound => 1, - Table_Initial => 100, - Table_Increment => 100); - -- The table that contains all packages - - function Image (Casing : Casing_Type) return String; - -- Similar to 'Image (but avoid use of this attribute in compiler) - - 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. - -- The following record contains data for a naming scheme type Naming_Data is record @@ -474,8 +803,6 @@ package Prj is -- 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) @@ -485,28 +812,14 @@ package Prj is -- 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 @@ -530,8 +843,48 @@ package Prj is -- 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); @@ -563,28 +916,141 @@ package Prj is 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 @@ -594,83 +1060,76 @@ package Prj is -- 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; @@ -679,38 +1138,40 @@ package Prj is 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 @@ -718,100 +1179,90 @@ package Prj is -- 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 - 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. + Minimum_Linker_Options : Name_List_Index := No_Name_List; + -- List of options specified in attribute + -- Language_Processing'Minimum_Linker_Options. + + 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 @@ -822,18 +1273,46 @@ package Prj is -- 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 @@ -850,19 +1329,19 @@ package Prj is 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; @@ -872,7 +1351,7 @@ package Prj is 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); @@ -880,19 +1359,19 @@ package Prj is 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, @@ -908,22 +1387,50 @@ package Prj is 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 @@ -975,9 +1482,32 @@ package Prj is -- 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; @@ -1023,6 +1553,17 @@ package Prj is 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; @@ -1071,7 +1612,7 @@ private -- 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, @@ -1093,5 +1634,7 @@ private 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; diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index 1afe327..a6803a0 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -33,6 +33,7 @@ with Opt; use Opt; with Table; +with Types; use Types; package body Snames is @@ -179,6 +180,7 @@ package body Snames is "ada_2005#" & "assertion_policy#" & "c_pass_by_copy#" & + "check_name#" & "compile_time_error#" & "compile_time_warning#" & "component_alignment#" & @@ -192,6 +194,7 @@ package body Snames is "extensions_allowed#" & "external_name_casing#" & "float_representation#" & + "implicit_packing#" & "initialize_scalars#" & "interrupt_state#" & "license#" & @@ -447,6 +450,7 @@ package body Snames is "digits#" & "elaborated#" & "emax#" & + "enabled#" & "enum_rep#" & "epsilon#" & "exponent#" & @@ -672,16 +676,12 @@ package body Snames is "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#" & @@ -689,21 +689,18 @@ package body Snames is "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#" & @@ -735,7 +732,7 @@ package body Snames is "library_symbol_file#" & "library_symbol_policy#" & "library_version#" & - "library_version_options#" & + "library_version_switches#" & "linker#" & "linker_executable_option#" & "linker_lib_dir_option#" & @@ -747,19 +744,19 @@ package body Snames is "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#" & @@ -853,15 +850,6 @@ package body Snames is 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 -- ----------------------- @@ -1032,15 +1020,6 @@ package body Snames is 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 -- ------------------------ diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 7795368..5fe569f 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -32,7 +32,6 @@ ------------------------------------------------------------------------------ with Namet; use Namet; -with Types; use Types; package Snames is @@ -342,58 +341,60 @@ 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 @@ -401,73 +402,73 @@ package Snames is -- 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 @@ -475,15 +476,15 @@ package Snames is -- 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 @@ -493,29 +494,29 @@ package Snames is -- 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 @@ -526,119 +527,119 @@ package Snames is -- 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 @@ -652,168 +653,169 @@ package Snames is -- 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 @@ -821,10 +823,10 @@ package Snames is -- 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 @@ -832,10 +834,10 @@ package Snames is -- 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 @@ -843,276 +845,269 @@ package Snames is -- 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 -- @@ -1156,6 +1151,7 @@ package Snames is Attribute_Digits, Attribute_Elaborated, Attribute_Emax, + Attribute_Enabled, Attribute_Enum_Rep, Attribute_Epsilon, Attribute_Exponent, @@ -1338,6 +1334,7 @@ package Snames is 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, @@ -1351,6 +1348,7 @@ package Snames is Pragma_Extensions_Allowed, Pragma_External_Name_Casing, Pragma_Float_Representation, + Pragma_Implicit_Packing, Pragma_Initialize_Scalars, Pragma_Interrupt_State, Pragma_License, @@ -1547,10 +1545,6 @@ package Snames is -- 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, @@ -1597,10 +1591,6 @@ package Snames is -- 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. @@ -1635,7 +1625,6 @@ private 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); diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index b84d771..e431a81 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -72,117 +72,118 @@ extern unsigned char Get_Attribute_Id (int); #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. */ @@ -221,156 +222,158 @@ extern unsigned char Get_Pragma_Id (int); #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) */ |