diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-07-13 10:45:14 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-07-13 10:45:14 +0000 |
| commit | d15bad045d8514e6c767e0bdc1cd2b2956274dbd (patch) | |
| tree | f36850a6b47b83f1fbdba5bbb834d88e131763f5 /gcc | |
| parent | 15a0a16549b258f53a99b57968c64192448df6cc (diff) | |
| download | gcc-d15bad045d8514e6c767e0bdc1cd2b2956274dbd.tar.gz | |
2009-07-13 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, make.adb, mlib-prj.adb, prj-ext.adb,
gnat_ugn.texi, prj.adb, prj.ads, clean.adb, prj-nmsc.adb, prj-util.adb,
prj-conf.adb, gnatname.adb, prj-env.adb, prj-env.ads, prj-tree.adb,
prj-tree.ads (Prj.Tree.Create*): New subprograms to create new packages
and attributes in a project tree.
(Add_Default_GNAT_Naming_Scheme): Provide real implementation.
Remove last remaining mode-specific code (ada_only or
multi_language). This was duplicating code
(Get_Mode, Set_Mode): removed, no longer used.
(Initialize_Project_Path): all tools will now take into account both
GPR_PROJECT_PATH and ADA_PROJECT_PATH (in that order).
Remove some global variables and subprograms no longer used
Make temporary files tree-specific, to avoid interferences between
trees loaded in memory at the same time.
(Prj.Delete_Temporary_File): new subprogram
(Object_Paths, Source_Paths): fields no longer stored in the project
tree, since they are only needed locally in Set_Ada_Paths.
(Set_Mapping_File_Initial_State_To_Empty): removed, since had no
effect in practice.
(Project_Tree_Data.Ada_Path_Buffer): removed, since it can be replaced
by local variables in the appropriate subprograms
(Has_Foreign_Sources): removed.
* gcc-interface/Makefile.in: prj-pp.o is now needed to build gnatmake
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149568 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 27 | ||||
| -rw-r--r-- | gcc/ada/clean.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Makefile.in | 2 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 16 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/gnatname.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 71 | ||||
| -rw-r--r-- | gcc/ada/mlib-prj.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 143 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 358 | ||||
| -rw-r--r-- | gcc/ada/prj-env.ads | 20 | ||||
| -rw-r--r-- | gcc/ada/prj-ext.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 441 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 118 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.adb | 200 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.ads | 79 | ||||
| -rw-r--r-- | gcc/ada/prj-util.adb | 68 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 231 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 128 |
19 files changed, 911 insertions, 1075 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8d276e8ef14..2e12962d541 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2009-07-13 Emmanuel Briot <briot@adacore.com> + + * gnatcmd.adb, prj-proc.adb, make.adb, mlib-prj.adb, prj-ext.adb, + gnat_ugn.texi, prj.adb, prj.ads, clean.adb, prj-nmsc.adb, prj-util.adb, + prj-conf.adb, gnatname.adb, prj-env.adb, prj-env.ads, prj-tree.adb, + prj-tree.ads (Prj.Tree.Create*): New subprograms to create new packages + and attributes in a project tree. + (Add_Default_GNAT_Naming_Scheme): Provide real implementation. + Remove last remaining mode-specific code (ada_only or + multi_language). This was duplicating code + (Get_Mode, Set_Mode): removed, no longer used. + (Initialize_Project_Path): all tools will now take into account both + GPR_PROJECT_PATH and ADA_PROJECT_PATH (in that order). + Remove some global variables and subprograms no longer used + Make temporary files tree-specific, to avoid interferences between + trees loaded in memory at the same time. + (Prj.Delete_Temporary_File): new subprogram + (Object_Paths, Source_Paths): fields no longer stored in the project + tree, since they are only needed locally in Set_Ada_Paths. + (Set_Mapping_File_Initial_State_To_Empty): removed, since had no + effect in practice. + (Project_Tree_Data.Ada_Path_Buffer): removed, since it can be replaced + by local variables in the appropriate subprograms + (Has_Foreign_Sources): removed. + + * gcc-interface/Makefile.in: prj-pp.o is now needed to build gnatmake + 2009-07-13 Arnaud Charlet <charlet@adacore.com> * gnat1drv.adb (Adjust_Global_Switches): No longer set diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 79c0431f982..e4d438732b5 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -1044,7 +1044,18 @@ package body Clean is begin Proj := Project_Tree.Projects; while Proj /= null loop - if Has_Foreign_Sources (Proj.Project) then + + -- for gnatmake, when the project specifies more than + -- Ada as a language (even if course we could not find + -- any source file for the other languages), we will + -- take all object files found in the object + -- directories. Since we know the project supports at + -- least Ada, we just have to test whether it has at + -- least two languages, and not care about the sources + + if Proj.Project.Languages /= null + and then Proj.Project.Languages.Next /= null + then Global_Archive := True; exit; end if; diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index ec0367de6f4..9ec41afa8ba 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -295,7 +295,7 @@ GNATMAKE_OBJS = a-except.o ali.o ali-util.o s-casuti.o \ make.o makeusg.o makeutl.o mlib.o mlib-fil.o mlib-prj.o mlib-tgt.o \ mlib-tgt-specific.o mlib-utl.o namet.o nlists.o opt.o osint.o osint-m.o \ output.o prj.o prj-attr.o prj-attr-pm.o prj-com.o prj-dect.o prj-env.o \ - prj-conf.o \ + prj-conf.o prj-pp.o \ prj-err.o prj-ext.o prj-nmsc.o prj-pars.o prj-part.o prj-proc.o prj-strt.o \ prj-tree.o prj-util.o rident.o s-exctab.o s-secsta.o s-stalib.o s-stoele.o \ scans.o scng.o sdefault.o sfn_scan.o s-purexc.o s-htable.o sinfo.o sinput.o \ diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index c88a2403193..08e6a6e88b3 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -12249,6 +12249,7 @@ is equivalent to the @command{gnatmake} invocation using the project file @node Importing Other Projects @subsection Importing Other Projects @cindex @code{ADA_PROJECT_PATH} +@cindex @code{GPR_PROJECT_PATH} @noindent A compilation unit in a source file in one project may depend on compilation @@ -12335,15 +12336,17 @@ if either The imported project file is in the same directory as the importing project file, or @item -You have defined ^an environment variable^a logical name^ +You have defined one or two ^environment variables^logical names^ that includes the directory containing -the needed project file. The syntax of @code{ADA_PROJECT_PATH} is the same as +the needed project file. The syntax of @code{GPR_PROJECT_PATH} and +@code{ADA_PROJECT_PATH} is the same as the syntax of @code{ADA_INCLUDE_PATH} and @code{ADA_OBJECTS_PATH}: a list of directory names separated by colons (semicolons on Windows). @end itemize @noindent -Thus, if we define @code{ADA_PROJECT_PATH} to include @file{^/gui^[GUI]^} and +Thus, if we define @code{ADA_PROJECT_PATH} or @code{GPR_PROJECT_PATH} +to include @file{^/gui^[GUI]^} and @file{^/comm^[COMM]^}, then our project file @file{app_proj.gpr} can be written as follows: @@ -13345,6 +13348,7 @@ define a package @code{Naming} (@pxref{Naming Schemes}). @node Importing Projects @section Importing Projects @cindex @code{ADA_PROJECT_PATH} +@cindex @code{GPR_PROJECT_PATH} @noindent An immediate source of a project P may depend on source files that @@ -13385,7 +13389,8 @@ files giving access to standard support libraries. @item In between, all the directories referenced in the -^environment variable^logical name^ @env{ADA_PROJECT_PATH} if it exists. +^environment variables^logical names^ @env{GPR_PROJECT_PATH} +and @env{ADA_PROJECT_PATH} if they exist, and in that order. @end itemize @noindent @@ -19049,6 +19054,7 @@ be accessed by the directive @option{-l@var{xxx}} at link time. @node Installing a library @subsection Installing a library @cindex @code{ADA_PROJECT_PATH} +@cindex @code{GPR_PROJECT_PATH} @noindent If you use project files, library installation is part of the library build @@ -19088,7 +19094,7 @@ responsibility of the library provider to install the necessary sources, ALI files and libraries in the directories mentioned in the project file. For convenience, the user's library project file should be installed in a location that will be searched automatically by the GNAT -builder. These are the directories referenced in the @env{ADA_PROJECT_PATH} +builder. These are the directories referenced in the @env{GPR_PROJECT_PATH} environment variable (@pxref{Importing Projects}), and also the default GNAT library location that can be queried with @command{gnatls -v} and is usually of the form $gnat_install_root/lib/gnat. diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 2aca64f5b27..fabf31ecaca 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -681,16 +681,8 @@ procedure GNATCmd is Proj := Project_Tree.Projects; while Proj /= null loop if Proj.Project.Config_File_Temp then - if Verbose_Mode then - Output.Write_Str ("Deleting temp configuration file """); - Output.Write_Str - (Get_Name_String (Proj.Project.Config_File_Name)); - Output.Write_Line (""""); - end if; - - Delete_File - (Name => Get_Name_String (Proj.Project.Config_File_Name), - Success => Success); + Delete_Temporary_File + (Project_Tree, Proj.Project.Config_File_Name); end if; Proj := Proj.Next; @@ -701,7 +693,7 @@ procedure GNATCmd is -- has been created, delete this temporary file. if Temp_File_Name /= No_Path then - Delete_File (Get_Name_String (Temp_File_Name), Success); + Delete_Temporary_File (Project_Tree, Temp_File_Name); end if; end Delete_Temp_Config_Files; @@ -1290,8 +1282,6 @@ begin VMS_Conv.Initialize; - Set_Mode (Ada_Only); - -- Add the default search directories, to be able to find system.ads in the -- subsequent call to Targparm.Get_Target_Parameters. @@ -2132,9 +2122,7 @@ begin -- indicate to gnatstub the name of the body file with -- a -o switch. - if Lang.Config.Naming_Data.Body_Suffix /= - Prj.Default_Ada_Spec_Suffix - then + if Is_Standard_GNAT_Naming (Lang.Config.Naming_Data) then if File_Index /= 0 then declare Spec : constant String := @@ -2355,7 +2343,7 @@ begin exception when Error_Exit => if not Keep_Temporary_Files then - Prj.Env.Delete_All_Path_Files (Project_Tree); + Prj.Delete_All_Temp_Files (Project_Tree); Delete_Temp_Config_Files; end if; @@ -2363,7 +2351,7 @@ exception when Normal_Exit => if not Keep_Temporary_Files then - Prj.Env.Delete_All_Path_Files (Project_Tree); + Prj.Delete_All_Temp_Files (Project_Tree); Delete_Temp_Config_Files; end if; diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index 7e817b5bf03..4e02ccae7dc 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2009, 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- -- @@ -524,8 +524,6 @@ procedure Gnatname is -- Start of processing for Gnatname begin - Prj.Set_Mode (Prj.Ada_Only); - -- Add the directory where gnatname is invoked in front of the -- path, if gnatname is invoked with directory information. -- Only do this if the platform is not VMS, where the notion of path diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 307d894b0e3..e69cec4a5ac 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -835,10 +835,6 @@ package body Make is Gnatmake_Mapping_File : String_Access := null; -- The path name of a mapping file specified by switch -C= - procedure Delete_Mapping_Files; - -- Delete all temporary mapping files. Called only in Delete_All_Temp_Files - -- which ensures that Debug_Flag_N is False. - procedure Init_Mapping_File (Project : Project_Id; Data : in out Project_Compilation_Data; @@ -3881,45 +3877,11 @@ package body Make is procedure Delete_All_Temp_Files is begin if not Debug.Debug_Flag_N then - Delete_Mapping_Files; Delete_Temp_Config_Files; - Prj.Env.Delete_All_Path_Files (Project_Tree); + Prj.Delete_All_Temp_Files (Project_Tree); end if; end Delete_All_Temp_Files; - -------------------------- - -- Delete_Mapping_Files -- - -------------------------- - - procedure Delete_Mapping_Files is - Success : Boolean; - pragma Warnings (Off, Success); - - Proj : Project_List; - Data : Project_Compilation_Access; - - begin - -- The caller is responsible for ensuring that Debug_Flag_N is False - - pragma Assert (not Debug.Debug_Flag_N); - - Proj := Project_Tree.Projects; - while Proj /= null loop - Data := Project_Compilation_Htable.Get - (Project_Compilation, Proj.Project); - - if Data /= null and then Data.Mapping_File_Names /= null then - for Index in 1 .. Data.Last_Mapping_File_Names loop - Delete_File - (Name => Get_Name_String (Data.Mapping_File_Names (Index)), - Success => Success); - end loop; - end if; - - Proj := Proj.Next; - end loop; - end Delete_Mapping_Files; - ------------------------------ -- Delete_Temp_Config_Files -- ------------------------------ @@ -3938,15 +3900,8 @@ package body Make is Proj := Project_Tree.Projects; while Proj /= null loop if Proj.Project.Config_File_Temp then - if Verbose_Mode then - Write_Str ("Deleting temp configuration file """); - Write_Str (Get_Name_String (Proj.Project.Config_File_Name)); - Write_Line (""""); - end if; - - Delete_File - (Name => Get_Name_String (Proj.Project.Config_File_Name), - Success => Success); + Delete_Temporary_File + (Project_Tree, Proj.Project.Config_File_Name); -- Make sure that we don't have a config file for this project, -- in case there are several mains. In this case, we will @@ -4375,7 +4330,7 @@ package body Make is begin Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path); - Record_Temp_File (Mapping_Path); + Record_Temp_File (Project_Tree, Mapping_Path); if Mapping_FD /= Invalid_FD then @@ -6069,13 +6024,10 @@ package body Make is exception when others => - -- If -dn was not specified, delete the temporary mapping - -- file, if one was created. + -- Delete the temporary mapping file, if one was created. - if not Debug.Debug_Flag_N - and then Mapping_Path /= No_Path - then - Delete_File (Get_Name_String (Mapping_Path), Discard); + if Mapping_Path /= No_Path then + Delete_Temporary_File (Project_Tree, Mapping_Path); end if; -- And reraise the exception @@ -6086,8 +6038,8 @@ package body Make is -- If -dn was not specified, delete the temporary mapping file, -- if one was created. - if not Debug.Debug_Flag_N and then Mapping_Path /= No_Path then - Delete_File (Get_Name_String (Mapping_Path), Discard); + if Mapping_Path /= No_Path then + Delete_Temporary_File (Project_Tree, Mapping_Path); end if; end Bind_Step; end if; @@ -6660,7 +6612,8 @@ package body Make is else Record_Temp_File - (Data.Mapping_File_Names (Data.Last_Mapping_File_Names)); + (Project_Tree, + Data.Mapping_File_Names (Data.Last_Mapping_File_Names)); end if; Close (FD, Status); @@ -6698,8 +6651,6 @@ package body Make is -- Start of processing for Initialize begin - Prj.Set_Mode (Ada_Only); - -- Override default initialization of Check_Object_Consistency since -- this is normally False for GNATBIND, but is True for GNATMAKE since -- we do not need to check source consistency again once GNATMAKE has diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index c8aad89ab69..51de49b60a7 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -1328,7 +1328,14 @@ package body MLib.Prj is In_Main_Object_Directory := True; - Foreign_Sources := Has_Foreign_Sources (For_Project); + -- for gnatmake, when the project specifies more than Ada as a + -- language (even if course we could not find any source file for + -- the other languages), we will take all object files found in the + -- object directories. Since we know the project supports at least + -- Ada, we just have to test whether it has at least two languages, + -- and not care about the sources + + Foreign_Sources := For_Project.Languages.Next /= null; Current_Proj := For_Project; loop diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 7c4cad3f48e..59b6c14025e 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -27,9 +27,11 @@ with Ada.Directories; use Ada.Directories; with GNAT.HTable; use GNAT.HTable; with Makeutl; use Makeutl; +with MLib.Tgt; with Opt; use Opt; with Output; use Output; with Prj.Part; +with Prj.PP; with Prj.Proc; use Prj.Proc; with Prj.Tree; use Prj.Tree; with Prj.Util; use Prj.Util; @@ -1123,7 +1125,56 @@ package body Prj.Conf is (Config_File : in out Project_Node_Id; Project_Tree : Project_Node_Tree_Ref) is - Name : Name_Id; + procedure Create_Attribute + (Name : Name_Id; + Value : String; + Index : String := ""; + Pkg : Project_Node_Id := Empty_Node); + + ---------------------- + -- Create_Attribute -- + ---------------------- + + procedure Create_Attribute + (Name : Name_Id; + Value : String; + Index : String := ""; + Pkg : Project_Node_Id := Empty_Node) + is + Attr : Project_Node_Id; + Val : Name_Id := No_Name; + Parent : Project_Node_Id := Config_File; + begin + if Index /= "" then + Name_Len := Index'Length; + Name_Buffer (1 .. Name_Len) := Index; + Val := Name_Find; + end if; + + if Pkg /= Empty_Node then + Parent := Pkg; + end if; + + Attr := Create_Attribute + (Tree => Project_Tree, + Prj_Or_Pkg => Parent, + Name => Name, + Index_Name => Val, + Kind => Prj.Single); + + Name_Len := Value'Length; + Name_Buffer (1 .. Name_Len) := Value; + Val := Name_Find; + + Set_Expression_Of + (Attr, Project_Tree, + Enclose_In_Expression + (Create_Literal_String (Val, Project_Tree), + Project_Tree)); + end Create_Attribute; + + Name : Name_Id; + Naming : Project_Node_Id; begin if Config_File = Empty_Node then @@ -1137,58 +1188,50 @@ package body Prj.Conf is Config_File := Create_Project (In_Tree => Project_Tree, - Name => Name, + Name => Name_Default, Full_Path => Path_Name_Type (Name), Is_Config_File => True); - -- ??? This isn't strictly required, since Prj.Nmsc.Add_Language - -- already has a workaround in the Ada_Only case. But it would be - -- nicer to do it this way - -- Likewise for the default language, hard-coded in - -- Pjr.Nmsc.Check_Programming_Languages - - -- Why is all the following code commented out??? - --- Update_Attribute_Value_In_Scenario --- (Tree => Project_Tree, --- Project => Config_File, --- Scenario_Variables => No_Scenario, --- Attribute => "default_language", --- Value => "Ada"); --- --- Update_Attribute_Value_In_Scenario --- (Tree => Project_Tree, --- Project => Config_File, --- Scenario_Variables => No_Scenario, --- Attribute => Separate_Suffix_Attribute, --- Value => ".adb", --- Attribute_Index => "Ada"); --- Update_Attribute_Value_In_Scenario --- (Tree => Project_Tree, --- Project => Config_File, --- Scenario_Variables => No_Scenario, --- Attribute => Spec_Suffix_Attribute, --- Value => ".ads", --- Attribute_Index => "Ada"); --- Update_Attribute_Value_In_Scenario --- (Tree => Project_Tree, --- Project => Config_File, --- Scenario_Variables => No_Scenario, --- Attribute => Impl_Suffix_Attribute, --- Value => ".adb", --- Attribute_Index => "Ada"); --- Update_Attribute_Value_In_Scenario --- (Tree => Project_Tree, --- Project => Config_File, --- Scenario_Variables => No_Scenario, --- Attribute => Dot_Replacement_Attribute, --- Value => "-"); --- Update_Attribute_Value_In_Scenario --- (Tree => Project_Tree, --- Project => Config_File, --- Scenario_Variables => No_Scenario, --- Attribute => Casing_Attribute, --- Value => "lowercase"); + -- Setup library support + + case MLib.Tgt.Support_For_Libraries is + when None => + null; + + when Static_Only => + Create_Attribute (Name_Library_Support, "static_only"); + + when Full => + Create_Attribute (Name_Library_Support, "full"); + end case; + + if MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported then + Create_Attribute (Name_Library_Auto_Init_Supported, "true"); + else + Create_Attribute (Name_Library_Auto_Init_Supported, "false"); + end if; + + -- Setup Ada support (Ada is the default language here, since this is + -- only called when no config file existed initially, ie for + -- gnatmake). + + Create_Attribute (Name_Default_Language, "ada"); + + Naming := Create_Package (Project_Tree, Config_File, "naming"); + Create_Attribute (Name_Spec_Suffix, ".ads", "ada", Pkg => Naming); + Create_Attribute (Name_Separate_Suffix, ".adb", "ada", Pkg => Naming); + Create_Attribute (Name_Body_Suffix, ".adb", "ada", Pkg => Naming); + Create_Attribute (Name_Dot_Replacement, "-", Pkg => Naming); + Create_Attribute (Name_Casing, "lowercase", Pkg => Naming); + + if Current_Verbosity = High then + Write_Line ("Automatically generated (in-memory) config file"); + Prj.PP.Pretty_Print + (Project => Config_File, + In_Tree => Project_Tree, + Backward_Compatibility => False); + + end if; end if; end Add_Default_GNAT_Naming_Scheme; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 93c51abe2cf..7541e52fedf 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -36,26 +36,47 @@ package body Prj.Env is -- Local Subprograms -- ----------------------- + package Source_Path_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 100); + -- A table to store the source dirs before creating the source path file + + package Object_Path_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Path_Name_Type, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 100); + -- A table to store the object dirs, before creating the object path file + procedure Add_To_Path (Source_Dirs : String_List_Id; - In_Tree : Project_Tree_Ref); + In_Tree : Project_Tree_Ref; + Buffer : in out String_Access; + Buffer_Last : in out Natural); -- Add to Ada_Path_Buffer all the source directories in string list - -- Source_Dirs, if any. Increment Ada_Path_Length. + -- Source_Dirs, if any. - procedure Add_To_Path (Dir : String; In_Tree : Project_Tree_Ref); + procedure Add_To_Path + (Dir : String; + Buffer : in out String_Access; + Buffer_Last : in out Natural); -- 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. + -- If Buffer_Last /= 0, prepend a Path_Separator character to Path. procedure Add_To_Source_Path - (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref); + (Source_Dirs : String_List_Id; + In_Tree : Project_Tree_Ref; + Source_Paths : in out Source_Path_Table.Instance); -- 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; - In_Tree : Project_Tree_Ref); + (Object_Dir : Path_Name_Type; + Object_Paths : in out Object_Path_Table.Instance); -- Add Object_Dir to object path table. Make sure it is not duplicate -- and it is the last one in the current table. @@ -67,14 +88,26 @@ package body Prj.Env is -- Return a project that is either Project or an extended ancestor of -- Project that itself is not extended. + procedure Create_Temp_File + (In_Tree : Project_Tree_Ref; + Path_FD : out File_Descriptor; + Path_Name : out Path_Name_Type; + File_Use : String); + -- Create a temporary file, and fail with an error if it could not be + -- created. + ---------------------- -- Ada_Include_Path -- ---------------------- function Ada_Include_Path - (Project : Project_Id; - In_Tree : Project_Tree_Ref) return String_Access + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Recursive : Boolean := False) return String is + Buffer : String_Access; + Buffer_Last : Natural := 0; + procedure Add (Project : Project_Id; Dummy : in out Boolean); -- Add source dirs of Project to the path @@ -85,50 +118,38 @@ package body Prj.Env is procedure Add (Project : Project_Id; Dummy : in out Boolean) is pragma Unreferenced (Dummy); begin - Add_To_Path (Project.Source_Dirs, In_Tree); + Add_To_Path (Project.Source_Dirs, In_Tree, Buffer, Buffer_Last); end Add; procedure For_All_Projects is new For_Every_Project_Imported (Boolean, Add); - Dummy : Boolean := False; - -- Start of processing for Ada_Include_Path + Dummy : Boolean := False; begin - -- If it is the first time we call this function for - -- this project, compute the source path - - if Project.Ada_Include_Path = null then - In_Tree.Private_Part.Ada_Path_Length := 0; - For_All_Projects (Project, Dummy); - - Project.Ada_Include_Path := - new String' - (In_Tree.Private_Part.Ada_Path_Buffer - (1 .. In_Tree.Private_Part.Ada_Path_Length)); - end if; + if Recursive then + -- If it is the first time we call this function for + -- this project, compute the source path + + if Project.Ada_Include_Path = null then + Buffer := new String (1 .. 4096); + For_All_Projects (Project, Dummy); + Project.Ada_Include_Path := new String'(Buffer (1 .. Buffer_Last)); + Free (Buffer); + end if; - return Project.Ada_Include_Path; - end Ada_Include_Path; + return Project.Ada_Include_Path.all; - ---------------------- - -- Ada_Include_Path -- - ---------------------- - - function Ada_Include_Path - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Recursive : Boolean) return String - is - begin - if Recursive then - return Ada_Include_Path (Project, In_Tree).all; else - In_Tree.Private_Part.Ada_Path_Length := 0; - Add_To_Path (Project.Source_Dirs, In_Tree); - return - In_Tree.Private_Part.Ada_Path_Buffer - (1 .. In_Tree.Private_Part.Ada_Path_Length); + Buffer := new String (1 .. 4096); + Add_To_Path (Project.Source_Dirs, In_Tree, Buffer, Buffer_Last); + + declare + Result : constant String := Buffer (1 .. Buffer_Last); + begin + Free (Buffer); + return Result; + end; end if; end Ada_Include_Path; @@ -138,9 +159,11 @@ package body Prj.Env is function Ada_Objects_Path (Project : Project_Id; - In_Tree : Project_Tree_Ref; Including_Libraries : Boolean := True) return String_Access is + Buffer : String_Access; + Buffer_Last : Natural := 0; + procedure Add (Project : Project_Id; Dummy : in out Boolean); -- Add all the object directories of a project to the path @@ -157,7 +180,7 @@ package body Prj.Env is Only_If_Ada => False); begin if Path /= No_Path then - Add_To_Path (Get_Name_String (Path), In_Tree); + Add_To_Path (Get_Name_String (Path), Buffer, Buffer_Last); end if; end Add; @@ -172,13 +195,11 @@ package body Prj.Env is -- this project, compute the objects path if Project.Ada_Objects_Path = null then - In_Tree.Private_Part.Ada_Path_Length := 0; + Buffer := new String (1 .. 4096); For_All_Projects (Project, Dummy); - Project.Ada_Objects_Path := - new String' - (In_Tree.Private_Part.Ada_Path_Buffer - (1 .. In_Tree.Private_Part.Ada_Path_Length)); + Project.Ada_Objects_Path := new String'(Buffer (1 .. Buffer_Last)); + Free (Buffer); end if; return Project.Ada_Objects_Path; @@ -189,39 +210,34 @@ 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; + Object_Paths : in out Object_Path_Table.Instance) is begin -- Check if the directory is already in the table for Index in Object_Path_Table.First .. - Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths) + Object_Path_Table.Last (Object_Paths) loop -- If it is, remove it, and add it as the last one - if In_Tree.Private_Part.Object_Paths.Table (Index) = Object_Dir then + if Object_Paths.Table (Index) = Object_Dir then for Index2 in Index + 1 .. - Object_Path_Table.Last - (In_Tree.Private_Part.Object_Paths) + Object_Path_Table.Last (Object_Paths) loop - In_Tree.Private_Part.Object_Paths.Table (Index2 - 1) := - In_Tree.Private_Part.Object_Paths.Table (Index2); + Object_Paths.Table (Index2 - 1) := Object_Paths.Table (Index2); end loop; - In_Tree.Private_Part.Object_Paths.Table - (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) := - Object_Dir; + Object_Paths.Table + (Object_Path_Table.Last (Object_Paths)) := Object_Dir; return; end if; end loop; -- The directory is not already in the table, add it - Object_Path_Table.Increment_Last (In_Tree.Private_Part.Object_Paths); - In_Tree.Private_Part.Object_Paths.Table - (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) := - Object_Dir; + Object_Path_Table.Append (Object_Paths, Object_Dir); end Add_To_Object_Path; ----------------- @@ -230,19 +246,26 @@ package body Prj.Env is procedure Add_To_Path (Source_Dirs : String_List_Id; - In_Tree : Project_Tree_Ref) + In_Tree : Project_Tree_Ref; + Buffer : in out String_Access; + Buffer_Last : in out Natural) is Current : String_List_Id := Source_Dirs; Source_Dir : String_Element; begin while Current /= Nil_String loop Source_Dir := In_Tree.String_Elements.Table (Current); - Add_To_Path (Get_Name_String (Source_Dir.Display_Value), In_Tree); + Add_To_Path (Get_Name_String (Source_Dir.Display_Value), + Buffer, Buffer_Last); Current := Source_Dir.Next; end loop; end Add_To_Path; - procedure Add_To_Path (Dir : String; In_Tree : Project_Tree_Ref) is + procedure Add_To_Path + (Dir : String; + Buffer : in out String_Access; + Buffer_Last : in out Natural) + is Len : Natural; New_Buffer : String_Access; Min_Len : Natural; @@ -280,19 +303,16 @@ package body Prj.Env is -- Start of processing for Add_To_Path begin - if Is_Present (In_Tree.Private_Part.Ada_Path_Buffer - (1 .. In_Tree.Private_Part.Ada_Path_Length), - Dir) - then + if Is_Present (Buffer (1 .. Buffer_Last), Dir) then -- Dir is already in the path, nothing to do return; end if; - Min_Len := In_Tree.Private_Part.Ada_Path_Length + Dir'Length; + Min_Len := Buffer_Last + Dir'Length; - if In_Tree.Private_Part.Ada_Path_Length > 0 then + if Buffer_Last > 0 then -- Add 1 for the Path_Separator character @@ -301,7 +321,7 @@ package body Prj.Env is -- If Ada_Path_Buffer is too small, increase it - Len := In_Tree.Private_Part.Ada_Path_Buffer'Last; + Len := Buffer'Last; if Len < Min_Len then loop @@ -310,25 +330,18 @@ package body Prj.Env is end loop; New_Buffer := new String (1 .. Len); - New_Buffer (1 .. In_Tree.Private_Part.Ada_Path_Length) := - In_Tree.Private_Part.Ada_Path_Buffer - (1 .. In_Tree.Private_Part.Ada_Path_Length); - Free (In_Tree.Private_Part.Ada_Path_Buffer); - In_Tree.Private_Part.Ada_Path_Buffer := New_Buffer; + New_Buffer (1 .. Buffer_Last) := Buffer (1 .. Buffer_Last); + Free (Buffer); + Buffer := New_Buffer; end if; - if In_Tree.Private_Part.Ada_Path_Length > 0 then - In_Tree.Private_Part.Ada_Path_Length := - In_Tree.Private_Part.Ada_Path_Length + 1; - In_Tree.Private_Part.Ada_Path_Buffer - (In_Tree.Private_Part.Ada_Path_Length) := Path_Separator; + if Buffer_Last > 0 then + Buffer_Last := Buffer_Last + 1; + Buffer (Buffer_Last) := Path_Separator; end if; - In_Tree.Private_Part.Ada_Path_Buffer - (In_Tree.Private_Part.Ada_Path_Length + 1 .. - In_Tree.Private_Part.Ada_Path_Length + Dir'Length) := Dir; - In_Tree.Private_Part.Ada_Path_Length := - In_Tree.Private_Part.Ada_Path_Length + Dir'Length; + Buffer (Buffer_Last + 1 .. Buffer_Last + Dir'Length) := Dir; + Buffer_Last := Buffer_Last + Dir'Length; end Add_To_Path; ------------------------ @@ -336,7 +349,9 @@ package body Prj.Env is ------------------------ procedure Add_To_Source_Path - (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref) + (Source_Dirs : String_List_Id; + In_Tree : Project_Tree_Ref; + Source_Paths : in out Source_Path_Table.Instance) is Current : String_List_Id := Source_Dirs; Source_Dir : String_Element; @@ -352,25 +367,18 @@ package body Prj.Env is -- Check if the source directory is already in the table for Index in Source_Path_Table.First .. - Source_Path_Table.Last - (In_Tree.Private_Part.Source_Paths) + Source_Path_Table.Last (Source_Paths) loop -- If it is already, no need to add it - if In_Tree.Private_Part.Source_Paths.Table (Index) = - Source_Dir.Value - then + if Source_Paths.Table (Index) = Source_Dir.Value then Add_It := False; exit; end if; end loop; if Add_It then - Source_Path_Table.Increment_Last - (In_Tree.Private_Part.Source_Paths); - In_Tree.Private_Part.Source_Paths.Table - (Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) := - Source_Dir.Value; + Source_Path_Table.Append (Source_Paths, Source_Dir.Value); end if; -- Next source directory @@ -533,21 +541,8 @@ package body Prj.Env is procedure Check_Temp_File is begin if File = Invalid_FD then - Tempdir.Create_Temp_File (File, Name => File_Name); - - if File = Invalid_FD then - Prj.Com.Fail - ("unable to create temporary configuration pragmas file"); - - 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; + Create_Temp_File + (In_Tree, File, File_Name, "configuration pragmas"); end if; end Check_Temp_File; @@ -795,7 +790,7 @@ package body Prj.Env is if Source.Unit /= No_Unit_Index then Get_Name_String (Source.Unit.Name); - if Get_Mode = Ada_Only then + if Source.Language.Config.Kind = Unit_Based then -- ??? Mapping_Spec_Suffix could be set in the case of -- gnatmake as well @@ -855,20 +850,7 @@ package body Prj.Env is -- 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; + Create_Temp_File (In_Tree, File, Name, "mapping"); For_Every_Imported_Project (Project, Dummy); GNAT.OS_Lib.Close (File, Status); @@ -883,66 +865,44 @@ package body Prj.Env is end if; end Create_Mapping_File; - -------------------------- - -- Create_New_Path_File -- - -------------------------- + ---------------------- + -- Create_Temp_File -- + ---------------------- - procedure Create_New_Path_File + procedure Create_Temp_File (In_Tree : Project_Tree_Ref; Path_FD : out File_Descriptor; - Path_Name : out Path_Name_Type) + Path_Name : out Path_Name_Type; + File_Use : String) is begin Tempdir.Create_Temp_File (Path_FD, Path_Name); if Path_Name /= No_Path then - Record_Temp_File (Path_Name); + if Current_Verbosity = High then + Write_Line ("Create temp file (" & File_Use & ") " + & Get_Name_String (Path_Name)); + end if; - -- Record the name, so that the temp path file will be deleted at the - -- end of the program. + Record_Temp_File (In_Tree, Path_Name); - Path_File_Table.Increment_Last (In_Tree.Private_Part.Path_Files); - In_Tree.Private_Part.Path_Files.Table - (Path_File_Table.Last (In_Tree.Private_Part.Path_Files)) := - Path_Name; + else + Prj.Com.Fail + ("unable to create temporary " & File_Use & " file"); end if; - end Create_New_Path_File; - - --------------------------- - -- Delete_All_Path_Files -- - --------------------------- + end Create_Temp_File; - procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref) is - Disregard : Boolean := True; - pragma Unreferenced (Disregard); + -------------------------- + -- Create_New_Path_File -- + -------------------------- + procedure Create_New_Path_File + (In_Tree : Project_Tree_Ref; + Path_FD : out File_Descriptor; + Path_Name : out Path_Name_Type) is begin - for Index in Path_File_Table.First .. - Path_File_Table.Last (In_Tree.Private_Part.Path_Files) - loop - if In_Tree.Private_Part.Path_Files.Table (Index) /= No_Path then - Delete_File - (Get_Name_String - (In_Tree.Private_Part.Path_Files.Table (Index)), - Disregard); - end if; - end loop; - - -- If any of the environment variables ADA_PRJ_INCLUDE_FILE or - -- ADA_PRJ_OBJECTS_FILE has been set, then reset their value to - -- the empty string. On VMS, this has the effect of deassigning - -- the logical names. - - if In_Tree.Private_Part.Ada_Prj_Include_File_Set then - Setenv (Project_Include_Path_File, ""); - In_Tree.Private_Part.Ada_Prj_Include_File_Set := False; - end if; - - if In_Tree.Private_Part.Ada_Prj_Objects_File_Set then - Setenv (Project_Objects_Path_File, ""); - In_Tree.Private_Part.Ada_Prj_Objects_File_Set := False; - end if; - end Delete_All_Path_Files; + Create_Temp_File (In_Tree, Path_FD, Path_Name, "path file"); + end Create_New_Path_File; ------------------------------------ -- File_Name_Of_Library_Unit_Body -- @@ -1345,7 +1305,6 @@ package body Prj.Env is procedure Initialize (In_Tree : Project_Tree_Ref) is begin - In_Tree.Private_Part.Fill_Mapping_File := True; In_Tree.Private_Part.Current_Source_Path_File := No_Path; In_Tree.Private_Part.Current_Object_Path_File := No_Path; end Initialize; @@ -1525,8 +1484,15 @@ package body Prj.Env is Including_Libraries : Boolean) is + Source_Paths : Source_Path_Table.Instance; + Object_Paths : Object_Path_Table.Instance; + -- List of source or object dirs. Only computed the first time this + -- procedure is called (since Source_FD is then reused) + Source_FD : File_Descriptor := Invalid_FD; Object_FD : File_Descriptor := Invalid_FD; + -- The temporary files to store the paths. These are only created the + -- first time this procedure is called, and reused from then on. Process_Source_Dirs : Boolean := False; Process_Object_Dirs : Boolean := False; @@ -1558,7 +1524,7 @@ package body Prj.Env is -- Ada sources. if Has_Ada_Sources (Project) then - Add_To_Source_Path (Project.Source_Dirs, In_Tree); + Add_To_Source_Path (Project.Source_Dirs, In_Tree, Source_Paths); end if; end if; @@ -1569,7 +1535,7 @@ package body Prj.Env is Only_If_Ada => True); if Path /= No_Path then - Add_To_Object_Path (Path, In_Tree); + Add_To_Object_Path (Path, Object_Paths); end if; end if; end Recursive_Add; @@ -1585,6 +1551,7 @@ package body Prj.Env is -- compute the source path and/or the object path. if Project.Include_Path_File = No_Path then + Source_Path_Table.Init (Source_Paths); Process_Source_Dirs := True; Create_New_Path_File (In_Tree, Source_FD, Project.Include_Path_File); @@ -1595,6 +1562,7 @@ package body Prj.Env is if Including_Libraries then if Project.Objects_Path_File_With_Libs = No_Path then + Object_Path_Table.Init (Object_Paths); Process_Object_Dirs := True; Create_New_Path_File (In_Tree, Object_FD, Project.Objects_Path_File_With_Libs); @@ -1602,6 +1570,7 @@ package body Prj.Env is else if Project.Objects_Path_File_Without_Libs = No_Path then + Object_Path_Table.Init (Object_Paths); Process_Object_Dirs := True; Create_New_Path_File (In_Tree, Object_FD, Project.Objects_Path_File_Without_Libs); @@ -1612,19 +1581,18 @@ package body Prj.Env is -- then call the recursive procedure Add for Project. if Process_Source_Dirs or Process_Object_Dirs then - Source_Path_Table.Set_Last (In_Tree.Private_Part.Source_Paths, 0); - Object_Path_Table.Set_Last (In_Tree.Private_Part.Object_Paths, 0); For_All_Projects (Project, Dummy); end if; - -- Write and close any file that has been created + -- Write and close any file that has been created. Source_FD is not set + -- when this subprogram is called a second time or more, since we reuse + -- the previous version of the file. if Source_FD /= Invalid_FD then for Index in Source_Path_Table.First .. - Source_Path_Table.Last - (In_Tree.Private_Part.Source_Paths) + Source_Path_Table.Last (Source_Paths) loop - Get_Name_String (In_Tree.Private_Part.Source_Paths.Table (Index)); + Get_Name_String (Source_Paths.Table (Index)); Name_Len := Name_Len + 1; Name_Buffer (Name_Len) := ASCII.LF; Len := Write (Source_FD, Name_Buffer (1)'Address, Name_Len); @@ -1643,10 +1611,9 @@ package body Prj.Env is if Object_FD /= Invalid_FD then for Index in Object_Path_Table.First .. - Object_Path_Table.Last - (In_Tree.Private_Part.Object_Paths) + Object_Path_Table.Last (Object_Paths) loop - Get_Name_String (In_Tree.Private_Part.Object_Paths.Table (Index)); + Get_Name_String (Object_Paths.Table (Index)); Name_Len := Name_Len + 1; Name_Buffer (Name_Len) := ASCII.LF; Len := Write (Object_FD, Name_Buffer (1)'Address, Name_Len); @@ -1705,17 +1672,6 @@ package body Prj.Env is end if; end Set_Ada_Paths; - --------------------------------------------- - -- Set_Mapping_File_Initial_State_To_Empty -- - --------------------------------------------- - - procedure Set_Mapping_File_Initial_State_To_Empty - (In_Tree : Project_Tree_Ref) - is - begin - In_Tree.Private_Part.Fill_Mapping_File := False; - end Set_Mapping_File_Initial_State_To_Empty; - ----------------------- -- Set_Path_File_Var -- ----------------------- diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 97a2d363d11..ffcea0756b6 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -55,12 +55,6 @@ package Prj.Env is -- -- See fmap for a description of the format of the mapping file - procedure Set_Mapping_File_Initial_State_To_Empty - (In_Tree : Project_Tree_Ref); - -- When creating a mapping file, create an empty map. This case occurs when - -- run time source files are found in the project files. This only applies - -- to the Ada_Only mode. - procedure Create_Config_Pragmas_File (For_Project : Project_Id; In_Tree : Project_Tree_Ref); @@ -72,19 +66,11 @@ package Prj.Env is 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; - -- Get the source search path of a Project file. For the first call, - -- compute it and cache it. function Ada_Include_Path (Project : Project_Id; In_Tree : Project_Tree_Ref; - Recursive : Boolean) return String; + Recursive : Boolean := False) return String; -- Get the source search path of a Project file. If Recursive it True, get -- all the source directories of the imported and modified project files -- (recursively). If Recursive is False, just get the path for the source @@ -93,7 +79,6 @@ package Prj.Env is function Ada_Objects_Path (Project : Project_Id; - In_Tree : Project_Tree_Ref; Including_Libraries : Boolean := True) return String_Access; -- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute -- it and cache it. When Including_Libraries is False, do not include the @@ -106,9 +91,6 @@ package Prj.Env is -- Set the environment variables for additional project path files, after -- creating the path files if necessary. - procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref); - -- Delete all temporary path files that have been created by Set_Ada_Paths - function File_Name_Of_Library_Unit_Body (Name : String; Project : Project_Id; diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 37c6296787f..853542ec494 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -25,7 +25,6 @@ with Hostparm; with Makeutl; use Makeutl; -with Output; use Output; with Osint; use Osint; with Sdefault; with Table; @@ -139,23 +138,8 @@ package body Prj.Ext is Last : Positive; New_Len : Positive; New_Last : Positive; - Prj_Path : String_Access := Gpr_Prj_Path; begin - if Gpr_Prj_Path.all /= "" then - - -- In Ada only mode, warn if both environment variables are defined - - if Get_Mode = Ada_Only and then 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; - - else - Prj_Path := Ada_Prj_Path; - end if; - -- The current directory is always first Name_Len := 1; @@ -172,11 +156,16 @@ package body Prj.Ext is -- If environment variable is defined and not empty, add its content - if Prj_Path.all /= "" then + if Gpr_Prj_Path.all /= "" then Name_Len := Name_Len + 1; Name_Buffer (Name_Len) := Path_Separator; + Add_Str_To_Name_Buffer (Gpr_Prj_Path.all); + end if; - Add_Str_To_Name_Buffer (Prj_Path.all); + if Ada_Prj_Path.all /= "" then + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Path_Separator; + Add_Str_To_Name_Buffer (Ada_Prj_Path.all); end if; -- Scan the directory path to see if "-" is one of the directories. @@ -260,12 +249,9 @@ package body Prj.Ext is Prefix := new String'(Executable_Prefix_Path); if Prefix.all /= "" then - if Get_Mode = Multi_Language then - Add_Str_To_Name_Buffer - (Path_Separator & Prefix.all & - "share" & Directory_Separator & "gpr"); - end if; - + Add_Str_To_Name_Buffer + (Path_Separator & Prefix.all & + "share" & Directory_Separator & "gpr"); Add_Str_To_Name_Buffer (Path_Separator & Prefix.all & Directory_Separator & "lib" & diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 3940e6ce81d..ec4e9a80440 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -28,11 +28,9 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Dynamic_HTables; with Err_Vars; use Err_Vars; -with MLib.Tgt; with Opt; use Opt; with Osint; use Osint; with Output; use Output; -with Prj.Env; use Prj.Env; with Prj.Err; with Prj.Util; use Prj.Util; with Sinput.P; @@ -52,9 +50,6 @@ package body Prj.Nmsc is -- Used in Check_Library for continuation error messages at the same -- location. - ALI_Suffix : constant String := ".ali"; - -- File suffix for ali files - type Name_Location is record Name : File_Name_Type; -- ??? duplicates the key Location : Source_Ptr; @@ -232,9 +227,6 @@ package body Prj.Nmsc is -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is -- converted to lower-case at the same time. - 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 a name is a valid Ada unit name @@ -278,16 +270,8 @@ package body Prj.Nmsc is -- tree Data.Tree and set the components of Data for all the programming -- languages indicated in attribute Languages, if any. - function Check_Project - (P : Project_Id; - Root_Project : Project_Id; - Extending : Boolean) return Boolean; - -- Returns True if P is Root_Project or, if Extending is True, a project - -- extended by Root_Project. - procedure Check_Stand_Alone_Library (Project : Project_Id; - Extending : Boolean; Data : in out Tree_Processing_Data); -- Check if project Project in project tree Data.Tree is a Stand-Alone -- Library project, and modify its data Data accordingly if it is one. @@ -304,6 +288,9 @@ package body Prj.Nmsc is -- Output an error message. If Data.Error_Report is null, simply call -- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use -- Error_Report. + -- If Msg starts with "?", this is a warning, and Warning: is adding at the + -- beginning. If Msg starts with "<", see comment + -- for Err_Vars.Error_Msg_Warn procedure Search_Directories (Project : in out Project_Processing_Data; @@ -747,12 +734,6 @@ package body Prj.Nmsc is -- is not null. if Unit /= No_Name then - Unit_Sources_Htable.Set (Data.Tree.Unit_Sources_HT, Unit, Id); - - -- ??? Record_Unit has already fetched that earlier, so this isn't - -- the most efficient way. But we can't really pass a parameter since - -- Process_Exceptions_Unit_Based and Check_File haven't looked it up. - UData := Units_Htable.Get (Data.Tree.Units_HT, Unit); if UData = No_Unit_Index then @@ -797,25 +778,6 @@ package body Prj.Nmsc is Files_Htable.Set (Data.File_To_Source, File_Name, Id); end Add_Source; - ------------------- - -- ALI_File_Name -- - ------------------- - - function ALI_File_Name (Source : String) return String is - begin - -- If the source name has extension, replace it with the ALI suffix - - for Index in reverse Source'First + 1 .. Source'Last loop - if Source (Index) = '.' then - return Source (Source'First .. Index - 1) & ALI_Suffix; - end if; - end loop; - - -- If no dot, or if it is the first character, just add the ALI suffix - - return Source & ALI_Suffix; - end ALI_File_Name; - ------------------------------ -- Canonical_Case_File_Name -- ------------------------------ @@ -896,11 +858,11 @@ package body Prj.Nmsc is end; end if; - -- Check configuration in multi language mode + -- Check configuration. This must be done even for gnatmake (even though + -- no user configuration file was provided) since the default config we + -- generate indicates whether libraries are supported for instance. - if Must_Check_Configuration then - Check_Configuration (Project, Data); - end if; + Check_Configuration (Project, Data); -- Library attributes @@ -982,7 +944,7 @@ package body Prj.Nmsc is -- If it is a library project file, check if it is a standalone library if Project.Library then - Check_Stand_Alone_Library (Project, Extending, Data); + Check_Stand_Alone_Library (Project, Data); end if; -- Put the list of Mains, if any, in the project data @@ -2420,8 +2382,9 @@ package body Prj.Nmsc is -- For file based languages, either Spec_Suffix or Body_Suffix -- need to be specified. - if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File and then - Lang_Index.Config.Naming_Data.Body_Suffix = No_File + if Data.Flags.Require_Sources_Other_Lang + and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File + and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File then Error_Msg_Name_1 := Lang_Index.Display_Name; Error_Msg @@ -3652,12 +3615,7 @@ package body Prj.Nmsc is end if; if Project.Library then - if Get_Mode = Multi_Language then - Support_For_Libraries := Project.Config.Lib_Support; - - else - Support_For_Libraries := MLib.Tgt.Support_For_Libraries; - end if; + Support_For_Libraries := Project.Config.Lib_Support; if Support_For_Libraries = Prj.None then Error_Msg @@ -4011,26 +3969,8 @@ package body Prj.Nmsc is Lang.Display_Name := Display_Name; if Name = Name_Ada then - Lang.Config.Kind := Unit_Based; + Lang.Config.Kind := Unit_Based; Lang.Config.Dependency_Kind := ALI_File; - - if Get_Mode = Ada_Only then - - -- Create a default config for Ada (since there is no - -- configuration file to create it for us). - - -- ??? We should do as GPS does and create a dummy config file - - Lang.Config.Naming_Data := - (Dot_Replacement => - File_Name_Type - (First_Name_Id + Character'Pos ('-')), - Casing => All_Lower_Case, - Separate_Suffix => Default_Ada_Body_Suffix, - Spec_Suffix => Default_Ada_Spec_Suffix, - Body_Suffix => Default_Ada_Body_Suffix); - end if; - else Lang.Config.Kind := File_Based; end if; @@ -4046,40 +3986,25 @@ package body Prj.Nmsc is Prj.Util.Value_Of (Name_Default_Language, Project.Decl.Attributes, Data.Tree); - -- Shouldn't these be set to False by default, and only set to True when - -- we actually find some source file??? - if Project.Source_Dirs /= Nil_String then -- Check if languages are specified in this project if Languages.Default then - -- In Ada_Only mode, the default language is Ada + -- Fail if there is no default language defined - if Get_Mode = Ada_Only then - Def_Lang_Id := Name_Ada; + if Def_Lang.Default then + Error_Msg + (Project, + "no languages defined for this project", + Project.Location, Data); + Def_Lang_Id := No_Name; else - -- Fail if there is no default language defined - - if Def_Lang.Default then - if not Default_Language_Is_Ada then - Error_Msg - (Project, - "no languages defined for this project", - Project.Location, Data); - Def_Lang_Id := No_Name; - - else - Def_Lang_Id := Name_Ada; - end if; - - else - Get_Name_String (Def_Lang.Value); - To_Lower (Name_Buffer (1 .. Name_Len)); - Def_Lang_Id := Name_Find; - end if; + Get_Name_String (Def_Lang.Value); + To_Lower (Name_Buffer (1 .. Name_Len)); + Def_Lang_Id := Name_Find; end if; if Def_Lang_Id /= No_Name then @@ -4129,42 +4054,12 @@ package body Prj.Nmsc is end if; end Check_Programming_Languages; - ------------------- - -- Check_Project -- - ------------------- - - function Check_Project - (P : Project_Id; - Root_Project : Project_Id; - Extending : Boolean) return Boolean - is - Prj : Project_Id; - - begin - if P = Root_Project then - return True; - - elsif Extending then - Prj := Root_Project; - while Prj.Extends /= No_Project loop - if P = Prj.Extends then - return True; - end if; - - Prj := Prj.Extends; - end loop; - end if; - - return False; - end Check_Project; - ------------------------------- -- Check_Stand_Alone_Library -- ------------------------------- procedure Check_Stand_Alone_Library (Project : Project_Id; - Extending : Boolean; Data : in out Tree_Processing_Data) is Lib_Interfaces : constant Prj.Variable_Value := @@ -4210,12 +4105,7 @@ package body Prj.Nmsc is Iter : Source_Iterator; begin - if Get_Mode = Multi_Language then - Auto_Init_Supported := Project.Config.Auto_Init_Supported; - else - Auto_Init_Supported := - MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported; - end if; + Auto_Init_Supported := Project.Config.Auto_Init_Supported; pragma Assert (Lib_Interfaces.Kind = List); @@ -4223,55 +4113,10 @@ package body Prj.Nmsc is -- Library_Interface is defined. if not Lib_Interfaces.Default then - SAL_Library : declare + declare Interfaces : String_List_Id := Lib_Interfaces.Values; Interface_ALIs : String_List_Id := Nil_String; Unit : Name_Id; - UData : Unit_Index; - - procedure Add_ALI_For (Source : File_Name_Type); - -- Add an ALI file name to the list of Interface ALIs - - ----------------- - -- Add_ALI_For -- - ----------------- - - procedure Add_ALI_For (Source : File_Name_Type) is - begin - Get_Name_String (Source); - - declare - 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; - ALI_Name_Id := Name_Find; - - String_Element_Table.Increment_Last - (Data.Tree.String_Elements); - - Data.Tree.String_Elements.Table - (String_Element_Table.Last - (Data.Tree.String_Elements)) := - (Value => ALI_Name_Id, - Index => 0, - Display_Value => ALI_Name_Id, - Location => - Data.Tree.String_Elements.Table - (Interfaces).Location, - Flag => False, - Next => Interface_ALIs); - - Interface_ALIs := - String_Element_Table.Last - (Data.Tree.String_Elements); - end; - end Add_ALI_For; - - -- Start of processing for SAL_Library begin Project.Standalone_Library := True; @@ -4304,155 +4149,76 @@ package body Prj.Nmsc is Unit := Name_Find; Error_Msg_Name_1 := Unit; - if Get_Mode = Ada_Only then - UData := Units_Htable.Get (Data.Tree.Units_HT, Unit); - - -- Check that the unit is part of the project - - if UData /= null - and then UData.File_Names (Impl) /= null - and then not UData.File_Names (Impl).Locally_Removed - then - if Check_Project - (UData.File_Names (Impl).Project, - Project, Extending) - then - -- There is a body for this unit. If there is no - -- spec, we need to check that it is not a subunit. - - if UData.File_Names (Spec) = null then - declare - Src_Ind : Source_File_Index; - - begin - Src_Ind := - Sinput.P.Load_Project_File - (Get_Name_String (UData.File_Names - (Impl).Path.Name)); - - if Sinput.P.Source_File_Is_Subunit - (Src_Ind) - then - Error_Msg - (Project, - "%% is a subunit; " & - "it cannot be an interface", - Data.Tree. - String_Elements.Table - (Interfaces).Location, - Data); - end if; - end; - end if; - - -- The unit is not a subunit, so we add the ALI - -- file for its body to the Interface ALIs. + Next_Proj := Project.Extends; + Iter := For_Each_Source (Data.Tree, Project); + loop + while Prj.Element (Iter) /= No_Source + and then + (Prj.Element (Iter).Unit = null + or else Prj.Element (Iter).Unit.Name /= Unit) + loop + Next (Iter); + end loop; - Add_ALI_For (UData.File_Names (Impl).File); + Source := Prj.Element (Iter); + exit when Source /= No_Source + or else Next_Proj = No_Project; - else - Error_Msg - (Project, - "%% is not an unit of this project", - Data.Tree.String_Elements.Table - (Interfaces).Location, Data); - end if; + Iter := For_Each_Source (Data.Tree, Next_Proj); + Next_Proj := Next_Proj.Extends; + end loop; - elsif UData /= null - and then UData.File_Names (Spec) /= null - and then not UData.File_Names (Spec).Locally_Removed - and then Check_Project - (UData.File_Names (Spec).Project, - Project, Extending) + if Source /= No_Source then + if Source.Kind = Sep then + Source := No_Source; + elsif Source.Kind = Spec + and then Other_Part (Source) /= No_Source then - -- The unit is part of the project, it has a spec, - -- but no body. We add the ALI for its spec to the - -- Interface ALIs. - - Add_ALI_For (UData.File_Names (Spec).File); - - else - Error_Msg - (Project, - "%% is not an unit of this project", - Data.Tree.String_Elements.Table - (Interfaces).Location, Data); - end if; - - else - Next_Proj := Project.Extends; - Iter := For_Each_Source (Data.Tree, Project); - loop - while Prj.Element (Iter) /= No_Source - and then - (Prj.Element (Iter).Unit = null - or else Prj.Element (Iter).Unit.Name /= Unit) - loop - Next (Iter); - end loop; - - Source := Prj.Element (Iter); - exit when Source /= No_Source - or else Next_Proj = No_Project; - - Iter := For_Each_Source (Data.Tree, Next_Proj); - Next_Proj := Next_Proj.Extends; - end loop; - - if Source /= No_Source then - if Source.Kind = Sep then - Source := No_Source; - elsif Source.Kind = Spec - and then Other_Part (Source) /= No_Source - then - Source := Other_Part (Source); - end if; + Source := Other_Part (Source); end if; + end if; - if Source /= No_Source then - if Source.Project /= Project - and then not Is_Extending (Project, Source.Project) - then - Source := No_Source; - end if; + if Source /= No_Source then + if Source.Project /= Project + and then not Is_Extending (Project, Source.Project) + then + Source := No_Source; end if; + end if; - if Source = No_Source then - Error_Msg - (Project, - "%% is not an unit of this project", - Data.Tree.String_Elements.Table - (Interfaces).Location, Data); - - else - if Source.Kind = Spec - and then Other_Part (Source) /= No_Source - then - Source := Other_Part (Source); - end if; - - -- Can't we use Append here??? - - String_Element_Table.Increment_Last - (Data.Tree.String_Elements); - + if Source = No_Source then + Error_Msg + (Project, + "%% is not a unit of this project", Data.Tree.String_Elements.Table - (String_Element_Table.Last - (Data.Tree.String_Elements)) := - (Value => Name_Id (Source.Dep_Name), - Index => 0, - Display_Value => Name_Id (Source.Dep_Name), - Location => - Data.Tree.String_Elements.Table - (Interfaces).Location, - Flag => False, - Next => Interface_ALIs); - - Interface_ALIs := - String_Element_Table.Last - (Data.Tree.String_Elements); + (Interfaces).Location, Data); + + else + if Source.Kind = Spec + and then Other_Part (Source) /= No_Source + then + Source := Other_Part (Source); end if; + + String_Element_Table.Increment_Last + (Data.Tree.String_Elements); + + Data.Tree.String_Elements.Table + (String_Element_Table.Last + (Data.Tree.String_Elements)) := + (Value => Name_Id (Source.Dep_Name), + Index => 0, + Display_Value => Name_Id (Source.Dep_Name), + Location => + Data.Tree.String_Elements.Table + (Interfaces).Location, + Flag => False, + Next => Interface_ALIs); + + Interface_ALIs := + String_Element_Table.Last + (Data.Tree.String_Elements); end if; end if; @@ -4502,7 +4268,7 @@ package body Prj.Nmsc is Lib_Auto_Init.Location, Data); end if; end if; - end SAL_Library; + end; -- If attribute Library_Src_Dir is defined and not the empty string, -- check if the directory exist and is not the object directory or @@ -4984,9 +4750,6 @@ package body Prj.Nmsc is First := First + 1; end if; - -- Warning character is always the first one in this package - -- this is an undocumented kludge??? - if Msg (First) = '?' then First := First + 1; Add ("Warning: "); @@ -5880,17 +5643,9 @@ package body Prj.Nmsc is is Filename : constant String := Get_Name_String (File_Name); Last : Integer := Filename'Last; - Sep_Len : constant Integer := - Integer (Length_Of_Name (Naming.Separate_Suffix)); - Body_Len : constant Integer := - Integer (Length_Of_Name (Naming.Body_Suffix)); - Spec_Len : constant Integer := - Integer (Length_Of_Name (Naming.Spec_Suffix)); - - Standard_GNAT : constant Boolean := - Naming.Spec_Suffix = Default_Ada_Spec_Suffix - and then - Naming.Body_Suffix = Default_Ada_Body_Suffix; + Sep_Len : Integer; + Body_Len : Integer; + Spec_Len : Integer; Unit_Except : Unit_Exception; Masked : Boolean := False; @@ -5899,6 +5654,13 @@ package body Prj.Nmsc is Unit := No_Name; Kind := Spec; + if Naming.Separate_Suffix = No_File + or else Naming.Body_Suffix = No_File + or else Naming.Spec_Suffix = No_File + then + return; + end if; + if Naming.Dot_Replacement = No_File then if Current_Verbosity = High then Write_Line (" No dot_replacement specified"); @@ -5907,6 +5669,10 @@ package body Prj.Nmsc is return; end if; + Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix)); + Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix)); + Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix)); + -- Choose the longest suffix that matches. If there are several matches, -- give priority to specs, then bodies, then separates. @@ -6008,7 +5774,9 @@ package body Prj.Nmsc is -- In the standard GNAT naming scheme, check for special cases: children -- or separates of A, G, I or S, and run time sources. - if Standard_GNAT and then Name_Len >= 3 then + if Is_Standard_GNAT_Naming (Naming) + and then Name_Len >= 3 + then declare S1 : constant Character := Name_Buffer (1); S2 : constant Character := Name_Buffer (2); @@ -6037,10 +5805,9 @@ package body Prj.Nmsc is elsif S2 = '.' then - -- If it is potentially a run time source, disable filling - -- of the mapping file to avoid warnings. + -- If it is potentially a run time source - Set_Mapping_File_Initial_State_To_Empty (In_Tree); + null; end if; end if; end; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 7c553af9c4a..b0c84d56b32 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -147,6 +147,13 @@ package body Prj.Proc is -- extended project, if any. Then process the declarative items of the -- project. + function Get_Attribute_Index + (Tree : Project_Node_Tree_Ref; + Attr : Project_Node_Id; + Index : Name_Id) return Name_Id; + -- Copy the index of the attribute into Name_Buffer, converting to lower + -- case if the attribute is case-insensitive. + --------- -- Add -- --------- @@ -436,6 +443,43 @@ package body Prj.Proc is end loop; end Copy_Package_Declarations; + ------------------------- + -- Get_Attribute_Index -- + ------------------------- + + function Get_Attribute_Index + (Tree : Project_Node_Tree_Ref; + Attr : Project_Node_Id; + Index : Name_Id) return Name_Id + is + Lower : Boolean; + begin + Get_Name_String (Index); + Lower := Case_Insensitive (Attr, Tree); + + -- The index is always case insensitive if it does not include any dot. + -- ??? Why not use the properties from prj-attr, simply, maybe because + -- we don't know whether we have a file as an index ? + + if not Lower then + Lower := True; + + for J in 1 .. Name_Len loop + if Name_Buffer (J) = '.' then + Lower := False; + exit; + end if; + end loop; + end if; + + if Lower then + To_Lower (Name_Buffer (1 .. Name_Len)); + return Name_Find; + else + return Index; + end if; + end Get_Attribute_Index; + ---------------- -- Expression -- ---------------- @@ -767,7 +811,6 @@ package body Prj.Proc is The_Array : Array_Id := No_Array; The_Element : Array_Element_Id := No_Array_Element; Array_Index : Name_Id := No_Name; - Lower : Boolean; begin if The_Package /= No_Package then @@ -789,33 +832,11 @@ package body Prj.Proc is if The_Array /= No_Array then The_Element := In_Tree.Arrays.Table (The_Array).Value; - - Get_Name_String (Index); - - Lower := - Case_Insensitive - (The_Current_Term, From_Project_Node_Tree); - - -- In multi-language mode (gprbuild), the index is - -- always case insensitive if it does not include - -- any dot. - - if Get_Mode = Multi_Language and then not Lower then - Lower := True; - - for J in 1 .. Name_Len loop - if Name_Buffer (J) = '.' then - Lower := False; - exit; - end if; - end loop; - end if; - - if Lower then - To_Lower (Name_Buffer (1 .. Name_Len)); - end if; - - Array_Index := Name_Find; + Array_Index := + Get_Attribute_Index + (From_Project_Node_Tree, + The_Current_Term, + Index); while The_Element /= No_Array_Element and then @@ -1835,7 +1856,8 @@ package body Prj.Proc is pragma Assert (Kind_Of (Current_Item, From_Project_Node_Tree) /= N_Attribute_Declaration, - "illegal attribute declaration"); + "illegal attribute declaration for " + & Get_Name_String (Current_Item_Name)); Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements); @@ -1877,47 +1899,17 @@ package body Prj.Proc is Index_Name : Name_Id := Associative_Array_Index_Of (Current_Item, From_Project_Node_Tree); - Lower : Boolean; The_Array : Array_Id; - The_Array_Element : Array_Element_Id := No_Array_Element; begin if Index_Name /= All_Other_Names then - -- Get the string index - - Get_Name_String - (Associative_Array_Index_Of + Index_Name := Get_Attribute_Index + (From_Project_Node_Tree, + Current_Item, + Associative_Array_Index_Of (Current_Item, From_Project_Node_Tree)); - - -- Put in lower case, if necessary - - Lower := - Case_Insensitive - (Current_Item, From_Project_Node_Tree); - - -- In multi-language mode (gprbuild), the index - -- is always case insensitive if it does not - -- include any dot. - - if Get_Mode = Multi_Language - and then not Lower - then - for J in 1 .. Name_Len loop - if Name_Buffer (J) = '.' then - Lower := False; - exit; - end if; - end loop; - end if; - - if Lower then - GNAT.Case_Util.To_Lower - (Name_Buffer (1 .. Name_Len)); - end if; - - Index_Name := Name_Find; end if; -- Look for the array in the appropriate list diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index e85078b3af9..42b281fad1e 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -2853,7 +2853,7 @@ package body Prj.Tree is Name, Prj.Tree.Tree_Private_Part.Project_Name_And_Node' (Name => Name, - Canonical_Path => No_Path, -- ??? in GPS: Path_Name_Type (Name), + Canonical_Path => No_Path, Node => Project, Extended => False, Proj_Qualifier => Qualifier)); @@ -2861,4 +2861,202 @@ package body Prj.Tree is return Project; end Create_Project; + ---------------- + -- Add_At_End -- + ---------------- + + procedure Add_At_End + (Tree : Project_Node_Tree_Ref; + Parent : Project_Node_Id; + Expr : Project_Node_Id; + Add_Before_First_Pkg : Boolean := False; + Add_Before_First_Case : Boolean := False) + is + Real_Parent : Project_Node_Id; + New_Decl, Decl, Next : Project_Node_Id; + Last, L : Project_Node_Id; + begin + if Kind_Of (Expr, Tree) /= N_Declarative_Item then + New_Decl := Default_Project_Node (Tree, N_Declarative_Item); + Set_Current_Item_Node (New_Decl, Tree, Expr); + else + New_Decl := Expr; + end if; + + if Kind_Of (Parent, Tree) = N_Project then + Real_Parent := Project_Declaration_Of (Parent, Tree); + else + Real_Parent := Parent; + end if; + + Decl := First_Declarative_Item_Of (Real_Parent, Tree); + + if Decl = Empty_Node then + Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl); + else + loop + Next := Next_Declarative_Item (Decl, Tree); + exit when Next = Empty_Node + or else + (Add_Before_First_Pkg + and then Kind_Of (Current_Item_Node (Next, Tree), Tree) + = N_Package_Declaration) + or else + (Add_Before_First_Case + and then Kind_Of (Current_Item_Node (Next, Tree), Tree) + = N_Case_Construction); + Decl := Next; + end loop; + + -- In case Expr is in fact a range of declarative items + Last := New_Decl; + loop + L := Next_Declarative_Item (Last, Tree); + exit when L = Empty_Node; + Last := L; + end loop; + + -- In case Expr is in fact a range of declarative items + Last := New_Decl; + loop + L := Next_Declarative_Item (Last, Tree); + exit when L = Empty_Node; + Last := L; + end loop; + + Set_Next_Declarative_Item (Last, Tree, Next); + Set_Next_Declarative_Item (Decl, Tree, New_Decl); + end if; + end Add_At_End; + + --------------------------- + -- Create_Literal_String -- + --------------------------- + + function Create_Literal_String + (Str : Namet.Name_Id; + Tree : Project_Node_Tree_Ref) + return Project_Node_Id + is + Node : Project_Node_Id; + begin + Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single); + Set_Next_Literal_String (Node, Tree, Empty_Node); + Set_String_Value_Of (Node, Tree, Str); + return Node; + end Create_Literal_String; + + --------------------------- + -- Enclose_In_Expression -- + --------------------------- + + function Enclose_In_Expression + (Node : Project_Node_Id; + Tree : Project_Node_Tree_Ref) return Project_Node_Id + is + Expr : constant Project_Node_Id := + Default_Project_Node (Tree, N_Expression, Single); + begin + Set_First_Term (Expr, Tree, Default_Project_Node (Tree, N_Term, Single)); + Set_Current_Term (First_Term (Expr, Tree), Tree, Node); + return Expr; + end Enclose_In_Expression; + + -------------------- + -- Create_Package -- + -------------------- + + function Create_Package + (Tree : Project_Node_Tree_Ref; + Project : Project_Node_Id; + Pkg : String) return Project_Node_Id + is + Pack : Project_Node_Id; + N : Name_Id; + begin + Name_Len := Pkg'Length; + Name_Buffer (1 .. Name_Len) := Pkg; + N := Name_Find; + + -- Check if the package already exists + + Pack := First_Package_Of (Project, Tree); + + while Pack /= Empty_Node loop + if Prj.Tree.Name_Of (Pack, Tree) = N then + return Pack; + end if; + + Pack := Next_Package_In_Project (Pack, Tree); + end loop; + + -- Create the package and add it to the declarative item + + Pack := Default_Project_Node (Tree, N_Package_Declaration); + Set_Name_Of (Pack, Tree, N); + + -- Find the correct package id to use + + Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N)); + + -- Add it to the list of packages + Set_Next_Package_In_Project + (Pack, Tree, First_Package_Of (Project, Tree)); + Set_First_Package_Of (Project, Tree, Pack); + + Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack); + + return Pack; + end Create_Package; + + ------------------- + -- Create_Attribute -- + ---------------------- + + function Create_Attribute + (Tree : Project_Node_Tree_Ref; + Prj_Or_Pkg : Project_Node_Id; + Name : Name_Id; + Index_Name : Name_Id := No_Name; + Kind : Variable_Kind := List; + At_Index : Integer := 0) return Project_Node_Id + is + Node : constant Project_Node_Id := + Default_Project_Node (Tree, N_Attribute_Declaration, Kind); + Case_Insensitive : Boolean; + + Pkg : Package_Node_Id; + Start_At : Attribute_Node_Id; + begin + Set_Name_Of (Node, Tree, Name); + + if At_Index /= 0 then + Set_Source_Index_Of (Node, Tree, To => Int (At_Index)); + end if; + + if Index_Name /= No_Name then + Set_Associative_Array_Index_Of (Node, Tree, Index_Name); + end if; + + if Prj_Or_Pkg /= Empty_Node then + Add_At_End (Tree, Prj_Or_Pkg, Node); + end if; + + -- Find out the case sensitivity of the attribute + + if Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration then + Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree)); + Start_At := First_Attribute_Of (Pkg); + else + Start_At := Attribute_First; + end if; + + Start_At := Attribute_Node_Id_Of (Name, Start_At); + Case_Insensitive := + Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array; + Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive; + + return Node; + end Create_Attribute; + end Prj.Tree; diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index 591c3dba272..ce449105cab 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -110,14 +110,6 @@ package Prj.Tree is -- the other components have default nil values. -- To create a node for a project itself, see Create_Project below instead - function Create_Project - (In_Tree : Project_Node_Tree_Ref; - Name : Name_Id; - Full_Path : Path_Name_Type; - Is_Config_File : Boolean := False) return Project_Node_Id; - -- Create a new node for a project and register it in the tree so that it - -- can be retrieved later on - function Hash (N : Project_Node_Id) return Header_Num; -- Used for hash tables where the key is a Project_Node_Id @@ -595,15 +587,84 @@ package Prj.Tree is In_Tree : Project_Node_Tree_Ref) return Boolean; -- Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes + ----------------------- + -- Create procedures -- + ----------------------- + -- The following procedures are used to edit a project file tree. They are + -- slightly higher-level than the Set_* procedures below + + function Create_Project + (In_Tree : Project_Node_Tree_Ref; + Name : Name_Id; + Full_Path : Path_Name_Type; + Is_Config_File : Boolean := False) return Project_Node_Id; + -- Create a new node for a project and register it in the tree so that it + -- can be retrieved later on + + function Create_Package + (Tree : Project_Node_Tree_Ref; + Project : Project_Node_Id; + Pkg : String) return Project_Node_Id; + -- Create a new package in Project. If the package already exists, it is + -- returned. + -- The name of the package *must* be lower-cases, or none of its attributes + -- will be recognized. + + function Create_Attribute + (Tree : Project_Node_Tree_Ref; + Prj_Or_Pkg : Project_Node_Id; + Name : Name_Id; + Index_Name : Name_Id := No_Name; + Kind : Variable_Kind := List; + At_Index : Integer := 0) return Project_Node_Id; + -- Create a new attribute. + -- The new declaration is added at the end of the declarative item list for + -- Prj_Or_Pkg (a project or a package), but before any package + -- declaration). No addition is done if Prj_Or_Pkg is Empty_Node. + -- If Index_Name is not "", then if creates an attribute value for a + -- specific index. + -- At_Index is used for the " at <idx>" in the naming exceptions. + -- Use Set_Expression_Of to set the value of the attribute (in which case + -- Enclose_In_Expression might be useful) + + function Create_Literal_String + (Str : Namet.Name_Id; + Tree : Project_Node_Tree_Ref) + return Project_Node_Id; + -- Create a literal string whose value is Str + + procedure Add_At_End + (Tree : Project_Node_Tree_Ref; + Parent : Project_Node_Id; + Expr : Project_Node_Id; + Add_Before_First_Pkg : Boolean := False; + Add_Before_First_Case : Boolean := False); + -- Add a new declarative item in the list in Parent. + -- This new declarative item will contain Expr (unless Expr is already a + -- declarative item, in which case it is added directly to the list). The + -- new item is inserted at the end of the list, unless Add_Before_First_Pkg + -- is True. In the latter case, it is added just before the first case + -- construction is seen, or before the first package (this assumes that all + -- packages are found at the end of the project, which isn't true in the + -- general case unless you have normalized the project to match this + -- description). + + function Enclose_In_Expression + (Node : Project_Node_Id; + Tree : Project_Node_Tree_Ref) return Project_Node_Id; + -- Enclose the Node inside a N_Expression node, and return this expression + -------------------- -- Set Procedures -- -------------------- -- The following procedures are part of the abstract interface of the -- Project File tree. - -- Each Set_* procedure is valid only for the same Project_Node_Kind -- nodes as the corresponding query function above. + -- These are very low-level, and manipulate the tree itself directly. You + -- should look at the Create_* procedure instead if you want to use higher + -- level constructs procedure Set_Name_Of (Node : Project_Node_Id; diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index 5e36fcd71e6..897e7f01dbe 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -130,8 +130,6 @@ package body Prj.Util is In_Package => Builder_Package, In_Tree => In_Tree); - Executable_Suffix : Variable_Value := Nil_Variable_Value; - Executable_Suffix_Name : Name_Id := No_Name; Lang : Language_Ptr; @@ -183,22 +181,7 @@ package body Prj.Util is end if; if Builder_Package /= No_Package then - if Get_Mode = Multi_Language then - Executable_Suffix_Name := Project.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; + Executable_Suffix_Name := Project.Config.Executable_Suffix; if Executable = Nil_Variable_Value and Ada_Main then Get_Name_String (Main); @@ -251,7 +234,8 @@ package body Prj.Util is -- possibly suffixed by the executable suffix. if Executable /= Nil_Variable_Value - and then Executable.Value /= Empty_Name + and then Executable.Value /= No_Name + and then Length_Of_Name (Executable.Value) /= 0 then -- Get the executable name. If Executable_Suffix is defined, -- make sure that it will be the extension of the executable. @@ -303,40 +287,24 @@ package body Prj.Util is Get_Name_String (Strip_Suffix (Main)); end if; - if Executable_Suffix /= Nil_Variable_Value - and then not Executable_Suffix.Default - then - -- If attribute Executable_Suffix is specified, add this suffix + -- Get the executable name. If Executable_Suffix is defined in the + -- configuration, make sure that it will be the extension of the + -- executable. - declare - Suffix : constant String := - Get_Name_String (Executable_Suffix.Value); - begin - Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix; - Name_Len := Name_Len + Suffix'Length; - return Name_Find; - end; + declare + Saved_EEOT : constant Name_Id := Executable_Extension_On_Target; + Result : File_Name_Type; - else - -- Get the executable name. If Executable_Suffix is defined in the - -- configuration, make sure that it will be the extension of the - -- executable. - - declare - Saved_EEOT : constant Name_Id := Executable_Extension_On_Target; - Result : File_Name_Type; - - begin - if Project.Config.Executable_Suffix /= No_Name then - Executable_Extension_On_Target := - Project.Config.Executable_Suffix; - end if; + begin + if Project.Config.Executable_Suffix /= No_Name then + Executable_Extension_On_Target := + Project.Config.Executable_Suffix; + end if; - Result := Executable_Name (Name_Find); - Executable_Extension_On_Target := Saved_EEOT; - return Result; - end; - end if; + Result := Executable_Name (Name_Find); + Executable_Extension_On_Target := Saved_EEOT; + return Result; + end; end Executable_Of; -------------- diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 45effae1682..c8f30ec5e76 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -28,10 +28,10 @@ with Ada.Unchecked_Deallocation; with Debug; with Osint; use Osint; +with Output; use Output; with Prj.Attr; with Prj.Err; use Prj.Err; with Snames; use Snames; -with Table; with Uintp; use Uintp; with GNAT.Directory_Operations; use GNAT.Directory_Operations; @@ -47,22 +47,18 @@ package body Prj is Initial_Buffer_Size : constant := 100; -- Initial size for extensible buffer used in Add_To_Buffer - Current_Mode : Mode := Ada_Only; - - The_Empty_String : Name_Id; - - Default_Ada_Spec_Suffix_Id : File_Name_Type; - Default_Ada_Body_Suffix_Id : File_Name_Type; - -- Initialized in Prj.Initialize, then never modified + The_Empty_String : Name_Id := No_Name; subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case; - The_Casing_Images : constant array (Known_Casing) of String_Access := - (All_Lower_Case => new String'("lowercase"), - All_Upper_Case => new String'("UPPERCASE"), - Mixed_Case => new String'("MixedCase")); - - Initialized : Boolean := False; + type Cst_String_Access is access constant String; + All_Lower_Case_Image : aliased constant String := "lowercase"; + All_Upper_Case_Image : aliased constant String := "UPPERCASE"; + Mixed_Case_Image : aliased constant String := "MixedCase"; + The_Casing_Images : constant array (Known_Casing) of Cst_String_Access := + (All_Lower_Case => All_Lower_Case_Image'Access, + All_Upper_Case => All_Upper_Case_Image'Access, + Mixed_Case => Mixed_Case_Image'Access); Project_Empty : constant Project_Data := (Qualifier => Unspecified, @@ -114,16 +110,6 @@ package body Prj is Depth => 0, Unkept_Comments => False); - 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. - procedure Free (Project : in out Project_Id); -- Free memory allocated for Project @@ -175,37 +161,76 @@ package body Prj is Last := Last + S'Length; end Add_To_Buffer; - ----------------------------- - -- Default_Ada_Body_Suffix -- - ----------------------------- + --------------------------- + -- Delete_Temporary_File -- + --------------------------- - function Default_Ada_Body_Suffix return File_Name_Type is + procedure Delete_Temporary_File + (Tree : Project_Tree_Ref; + Path : Path_Name_Type) + is + Dont_Care : Boolean; + pragma Warnings (Off, Dont_Care); begin - return Default_Ada_Body_Suffix_Id; - end Default_Ada_Body_Suffix; + if not Debug.Debug_Flag_N then + if Current_Verbosity = High then + Write_Line ("Removing temp file: " & Get_Name_String (Path)); + end if; - ----------------------------- - -- Default_Ada_Spec_Suffix -- - ----------------------------- + Delete_File (Get_Name_String (Path), Dont_Care); - function Default_Ada_Spec_Suffix return File_Name_Type is - begin - return Default_Ada_Spec_Suffix_Id; - end Default_Ada_Spec_Suffix; + for Index in + 1 .. Temp_Files_Table.Last (Tree.Private_Part.Temp_Files) + loop + if Tree.Private_Part.Temp_Files.Table (Index) = Path then + Tree.Private_Part.Temp_Files.Table (Index) := No_Path; + end if; + end loop; + end if; + end Delete_Temporary_File; --------------------------- -- Delete_All_Temp_Files -- --------------------------- - procedure Delete_All_Temp_Files is + procedure Delete_All_Temp_Files (Tree : Project_Tree_Ref) is Dont_Care : Boolean; pragma Warnings (Off, Dont_Care); + Path : Path_Name_Type; 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); + for Index in + 1 .. Temp_Files_Table.Last (Tree.Private_Part.Temp_Files) + loop + Path := Tree.Private_Part.Temp_Files.Table (Index); + + if Path /= No_Path then + if Current_Verbosity = High then + Write_Line ("Removing temp file: " + & Get_Name_String (Path)); + end if; + + Delete_File (Get_Name_String (Path), Dont_Care); + end if; end loop; + + Temp_Files_Table.Free (Tree.Private_Part.Temp_Files); + Temp_Files_Table.Init (Tree.Private_Part.Temp_Files); + end if; + + -- If any of the environment variables ADA_PRJ_INCLUDE_FILE or + -- ADA_PRJ_OBJECTS_FILE has been set, then reset their value to + -- the empty string. On VMS, this has the effect of deassigning + -- the logical names. + + if Tree.Private_Part.Ada_Prj_Include_File_Set then + Setenv (Project_Include_Path_File, ""); + Tree.Private_Part.Ada_Prj_Include_File_Set := False; + end if; + + if Tree.Private_Part.Ada_Prj_Objects_File_Set then + Setenv (Project_Objects_Path_File, ""); + Tree.Private_Part.Ada_Prj_Objects_File_Set := False; end if; end Delete_All_Temp_Files; @@ -536,15 +561,6 @@ package body Prj is return Result; end Find_Source; - -------------- - -- Get_Mode -- - -------------- - - function Get_Mode return Mode is - begin - return Current_Mode; - end Get_Mode; - ---------- -- Hash -- ---------- @@ -585,25 +601,29 @@ package body Prj is return The_Casing_Images (Casing).all; end Image; + ----------------------------- + -- Is_Standard_GNAT_Naming -- + ----------------------------- + + function Is_Standard_GNAT_Naming + (Naming : Lang_Naming_Data) return Boolean + is + begin + return Get_Name_String (Naming.Spec_Suffix) = ".ads" + and then Get_Name_String (Naming.Body_Suffix) = ".adb" + and then Get_Name_String (Naming.Dot_Replacement) = "-"; + end Is_Standard_GNAT_Naming; + ---------------- -- Initialize -- ---------------- procedure Initialize (Tree : Project_Tree_Ref) is begin - if not Initialized then - Initialized := True; + if The_Empty_String = No_Name then Uintp.Initialize; Name_Len := 0; The_Empty_String := Name_Find; - Empty_Name := The_Empty_String; - Empty_File_Name := File_Name_Type (The_Empty_String); - Name_Len := 4; - Name_Buffer (1 .. 4) := ".ads"; - Default_Ada_Spec_Suffix_Id := Name_Find; - Name_Len := 4; - Name_Buffer (1 .. 4) := ".adb"; - Default_Ada_Body_Suffix_Id := Name_Find; Prj.Attr.Initialize; Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); @@ -616,18 +636,6 @@ package body Prj is end if; end Initialize; - ------------------- - -- Is_A_Language -- - ------------------- - - function Is_A_Language - (Project : Project_Id; - Language_Name : Name_Id) return Boolean is - begin - return Get_Language_From_Name - (Project, Get_Name_String (Language_Name)) /= null; - end Is_A_Language; - ------------------ -- Is_Extending -- ------------------ @@ -673,10 +681,11 @@ package body Prj is -- Record_Temp_File -- ---------------------- - procedure Record_Temp_File (Path : Path_Name_Type) is + procedure Record_Temp_File + (Tree : Project_Tree_Ref; + Path : Path_Name_Type) is begin - Temp_Files.Increment_Last; - Temp_Files.Table (Temp_Files.Last) := Path; + Temp_Files_Table.Append (Tree.Private_Part.Temp_Files, Path); end Record_Temp_File; ---------- @@ -833,22 +842,13 @@ package body Prj is Array_Table.Free (Tree.Arrays); Package_Table.Free (Tree.Packages); Source_Paths_Htable.Reset (Tree.Source_Paths_HT); - Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT); Free_List (Tree.Projects, Free_Project => True); Free_Units (Tree.Units_HT); -- Private part - Path_File_Table.Free (Tree.Private_Part.Path_Files); - Source_Path_Table.Free (Tree.Private_Part.Source_Paths); - Object_Path_Table.Free (Tree.Private_Part.Object_Paths); - - Free (Tree.Private_Part.Ada_Path_Buffer); - - -- Naming data (nothing to free ???) - - null; + Temp_Files_Table.Free (Tree.Private_Part.Temp_Files); Unchecked_Free (Tree); end if; @@ -869,45 +869,20 @@ package body Prj is Array_Table.Init (Tree.Arrays); Package_Table.Init (Tree.Packages); Source_Paths_Htable.Reset (Tree.Source_Paths_HT); - Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT); Free_List (Tree.Projects, Free_Project => True); Free_Units (Tree.Units_HT); -- Private part table - 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); + Temp_Files_Table.Init (Tree.Private_Part.Temp_Files); - if Current_Mode = Ada_Only then - Tree.Private_Part.Current_Source_Path_File := No_Path; - Tree.Private_Part.Current_Object_Path_File := No_Path; - Tree.Private_Part.Ada_Path_Length := 0; - Tree.Private_Part.Ada_Prj_Include_File_Set := False; - Tree.Private_Part.Ada_Prj_Objects_File_Set := False; - Tree.Private_Part.Fill_Mapping_File := True; - end if; + Tree.Private_Part.Current_Source_Path_File := No_Path; + Tree.Private_Part.Current_Object_Path_File := No_Path; + Tree.Private_Part.Ada_Prj_Include_File_Set := False; + Tree.Private_Part.Ada_Prj_Objects_File_Set := False; end Reset; - -------------- - -- Set_Mode -- - -------------- - - procedure Set_Mode (New_Mode : Mode) is - begin - Current_Mode := New_Mode; - - case New_Mode is - when Ada_Only => - Default_Language_Is_Ada := True; - Must_Check_Configuration := False; - when Multi_Language => - Default_Language_Is_Ada := False; - Must_Check_Configuration := True; - end case; - end Set_Mode; - ------------------- -- Switches_Name -- ------------------- @@ -953,29 +928,6 @@ package body Prj is return False; end Has_Ada_Sources; - ------------------------- - -- Has_Foreign_Sources -- - ------------------------- - - function Has_Foreign_Sources (Data : Project_Id) return Boolean is - Lang : Language_Ptr; - - begin - Lang := Data.Languages; - while Lang /= No_Language_Index loop - if Lang.Name /= Name_Ada - and then - (Current_Mode = Ada_Only or else Lang.First_Source /= No_Source) - then - return True; - end if; - - Lang := Lang.Next; - end loop; - - return False; - end Has_Foreign_Sources; - ------------------------ -- Contains_ALI_Files -- ------------------------ @@ -1153,7 +1105,8 @@ package body Prj is function Is_Compilable (Source : Source_Id) return Boolean is begin - return Source.Language.Config.Compiler_Driver /= Empty_File_Name + return Source.Language.Config.Compiler_Driver /= No_File + and then Length_Of_Name (Source.Language.Config.Compiler_Driver) /= 0 and then not Source.Locally_Removed; end Is_Compilable; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 47851fbebce..b359515eaae 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -59,10 +59,6 @@ package Prj is 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); - -- Ada_Only: mode for gnatmake, gnatclean, gnatname, the GNAT driver - -- Multi_Language: mode for gprbuild, gprclean - type Project_Qualifier is (Unspecified, Standard, @@ -80,23 +76,6 @@ package Prj is -- Aggregate_Library: aggregate library project is ... -- Configuration: configuration project is ... - function Get_Mode return Mode; - pragma Inline (Get_Mode); - - procedure Set_Mode (New_Mode : Mode); - pragma Inline (Set_Mode); - - Default_Language_Is_Ada : Boolean := True; - -- If no language was defined in the project or the configuration file, it - -- is an error, unless this variable is True, in which case it defaults to - -- Ada. Calling Set_Mode will reset this variable, default is for Ada_Only. - - Must_Check_Configuration : Boolean := False; - -- True when the contents of the configuration file must be checked. This - -- is in general only needed by gprbuild itself, since other applications - -- can ignore such errors when they don't need to build directly. Calling - -- Set_Mode will reset this variable, default is for Ada_Only. - 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. @@ -111,16 +90,6 @@ package Prj is procedure Free (Tree : in out Project_Tree_Ref); -- Free memory associated with the tree - function Default_Ada_Spec_Suffix return File_Name_Type; - pragma Inline (Default_Ada_Spec_Suffix); - -- 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 for the standard GNAT suffix for Ada body source file name - -- ".adb". Initialized by Prj.Initialize. - Config_Project_File_Extension : String := ".cgpr"; Project_File_Extension : String := ".gpr"; -- The standard config and user project file name extensions. They are not @@ -392,6 +361,11 @@ package Prj is Spec_Suffix => No_File, Body_Suffix => No_File); + function Is_Standard_GNAT_Naming (Naming : Lang_Naming_Data) return Boolean; + -- True if the naming scheme is GNAT's default naming scheme. This + -- is to take into account shortened names like "Ada." (a-), "System." (s-) + -- and so on. + type Source_Data; type Source_Id is access all Source_Data; @@ -1244,18 +1218,9 @@ package Prj is Extended : Project_Id) return Boolean; -- Return True if Extending is extending the Extended project - function Is_A_Language - (Project : Project_Id; - Language_Name : Name_Id) return Boolean; - -- Return True when Language_Name (which must be lower case) is one of the - -- languages used for the project. - function Has_Ada_Sources (Data : Project_Id) return Boolean; -- Return True if the project has Ada sources - function Has_Foreign_Sources (Data : Project_Id) return Boolean; - -- Return True if the project has foreign sources - Project_Error : exception; -- Raised by some subprograms in Prj.Attr @@ -1314,13 +1279,14 @@ package Prj is Arrays : Array_Table.Instance; Packages : Package_Table.Instance; Projects : Project_List; + Units_HT : Units_Htable.Instance; - Source_Paths_HT : Source_Paths_Htable.Instance; - Unit_Sources_HT : Unit_Sources_Htable.Instance; + -- Unit name to Unit_Index (and from there so Source_Id) - -- Private part + Source_Paths_HT : Source_Paths_Htable.Instance; + -- Full path to Source_Id - Private_Part : Private_Project_Tree_Data; + Private_Part : Private_Project_Tree_Data; end record; -- Data for a project tree @@ -1369,7 +1335,8 @@ package Prj is -- If Require_Sources_Other_Lang is true, then all languages must have at -- least one source file, or an error is reported via When_No_Sources. If -- it is false, this is only required for Ada (and only if it is a language - -- of the project). + -- of the project). When this parameter is set to False, we do not check + -- that a proper naming scheme is defined for languages other than Ada. -- -- If Report_Error is null, use the standard error reporting mechanism -- (Errout). Otherwise, report errors using Report_Error. @@ -1436,12 +1403,23 @@ package Prj is -- Temp Files -- ---------------- - procedure Record_Temp_File (Path : Path_Name_Type); + procedure Record_Temp_File + (Tree : Project_Tree_Ref; + 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 + procedure Delete_All_Temp_Files (Tree : Project_Tree_Ref); + -- Delete all recorded temporary files. + -- Does nothing if Debug.Debug_Flag_N is set + + procedure Delete_Temporary_File + (Tree : Project_Tree_Ref; + Path : Path_Name_Type); + -- Delete a temporary file from the disk. The file is also removed from the + -- list of temporary files to delete at the end of the program, in case + -- another program running on the same machine has recreated it. + -- Does nothing if Debug.Debug_Flag_N is set private @@ -1461,14 +1439,6 @@ private -- The prefix for virtual extending projects. Because of the '$', which is -- normally forbidden for project names, there cannot be any name clash. - Empty_Name : Name_Id; - -- Name_Id for an empty name (no characters). Initialized in procedure - -- Initialize. - - Empty_File_Name : File_Name_Type; - -- Empty File_Name_Type (no characters). Initialized in procedure - -- Initialize. - type Source_Iterator is record In_Tree : Project_Tree_Ref; @@ -1491,35 +1461,19 @@ private Last : in out Natural); -- Append a String to the Buffer - package Path_File_Table is new GNAT.Dynamic_Tables + package Temp_Files_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Path_Name_Type, - Table_Index_Type => Natural, + Table_Index_Type => Integer, Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 100); - -- Table storing all the temp path file names. - -- Used by Delete_All_Path_Files. - - package Source_Path_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Name_Id, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 100); - -- A table to store the source dirs before creating the source path file - - package Object_Path_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Path_Name_Type, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 100); - -- A table to store the object dirs, before creating the object path file + Table_Initial => 10, + Table_Increment => 10); + -- 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. type Private_Project_Tree_Data is record - Path_Files : Path_File_Table.Instance; - Source_Paths : Source_Path_Table.Instance; - Object_Paths : Object_Path_Table.Instance; + Temp_Files : Temp_Files_Table.Instance; + -- Temporary files created as part of running tools (pragma files, + -- mapping files,...) Current_Source_Path_File : Path_Name_Type := No_Path; -- Current value of project source path file env var. Used to avoid @@ -1531,15 +1485,6 @@ private -- setting the env var to the same value. -- gnatmake only - Ada_Path_Buffer : String_Access := new String (1 .. 1024); - -- A buffer where values for ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are - -- stored. - -- gnatmake only - - Ada_Path_Length : Natural := 0; - -- Index of the last valid character in Ada_Path_Buffer - -- gnatmake only - Ada_Prj_Include_File_Set : Boolean := False; Ada_Prj_Objects_File_Set : Boolean := False; -- These flags are set to True when the corresponding environment @@ -1550,9 +1495,6 @@ private -- caller. -- gnatmake only - Fill_Mapping_File : Boolean := True; - -- gnatmake only - end record; -- Type to represent the part of a project tree which is private to the -- Project Manager. |