diff options
| -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 21bd566f82f..b9743333f85 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 244e228a609..ca207fffb91 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 abd55112638..ce4ff4c0091 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 c7a96aa04c6..3dcdfb4a13d 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 13889a4b4d9..139175c859b 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 589a98b430b..80d1b9f80c5 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 a3a3db77c9b..74bb9fcbc75 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 4ab0a905322..557f11c8087 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 c8ffaef81c0..551984be4d1 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 0bb83a52b31..b742c01b331 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 7918ea1546c..59ba9c8b779 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 0b8e34e9d82..e09ffc83b89 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 237a9341b1e..840b121057f 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 f58e59f8748..19e41b7ed37 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 38f8d8130a2..10d03904fa4 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 fe279f9cd1b..78870d60b4f 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 ec384052cae..99560f570c5 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 c5a69926aa6..c90e00877cc 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 470e0a8e84a..b0a9bd61366 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 4c00ac49a13..a49e9a8c845 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 4163f98b2c8..ffb606ed5ae 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 ea7807b3ac4..2d0866c3b4d 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 1b2e3583b82..47bc052cb5d 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 1afe327aa9a..a6803a006f6 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 7795368b56c..5fe569f5e7e 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 b84d771c916..e431a81f8ba 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) */ |