From 68c3f02a687ec4e6dd51392f1154da5690cd7963 Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Tue, 8 Apr 2008 08:48:54 +0200 Subject: [PATCH] clean.adb (Parse_Cmd_Line): Recognize switch --subdirs= 2008-04-08 Vincent Celier * clean.adb (Parse_Cmd_Line): Recognize switch --subdirs= (Usage): Add line for switch --subdirs= Add new switch -eL, to follow symbolic links when processing project files. * gnatcmd.adb: Process switches -eL and --subdirs= (Non_VMS_Usage): Output "gnaampcmd" instead of "gnat", and call Program_Name to get proper tool names when AAMP_On_Target is set. (Gnatcmd): Call Add_Default_Search_Dirs and Get_Target_Parameters to get AAMP_On_Target set properly for use of GNAAMP tools (this is needed by Osint.Program_Name). * gnatname.adb: (Scan_Args): Recognize switches -eL and --subdirs= (Usage): Add lines for switches -eL and --subdirs= * makeusg.adb: Add line for switch --subdirs= * prj.ads: (Source_Data): New Boolean component Compiled, defaulted to True (Empty_File_Name: New global variable in private part, initialized in procedure Initialize. (Subdirs_Option): New constant string (Subdirs): New String_Ptr global variable (Language_Config): New component Include_Compatible_Languages (Project_Qualifier): New type for project qualifiers (Project_Data): New component Qualifier (Project_Configuration): New component Archive_Builder_Append_Option * prj-nmsc.adb (Get_Unit_Exceptions): When a unit is already in another imported project indicate the name of this imported project. (Check_File): When a unit is in two project files, indicate the project names and the paths of the source files for each project. (Add_Source): Set Compiled to False if compiler driver is empty. Only set object, dependency and switches file names if Compiled is True. (Process_Compiler): Allow the empty string for value of attribute Driver (Get_Directories): When Subdirs is not null and Object_Dir is not specified, locate and create if necessary the actual object dir. (Locate_Directory): When Subdirs is not empty and Create is not the empty string, locate and create if necessary the actual directory as a subdirectory of directory Name. (Check_Library_Attributes.Check_Library): Allow a project where the only "sources" are header files of file based languages to be imported by library projects, in multi-language mode (gprbuild). (Check_Library_Attributes.Check_Library): In multi-language mode (gprbuild), allow a library project to import a project with no sources, even when this is not declared explicitly. (Check_If_Externally_Built): A virtual project extending an externally built project is also externally built. (Check_Library_Attributes): For a virtual project extending a library project, inherit the library directory. (Process_Project_Level_Array_Attributes): Process new attribute Inherit_Source_Path. For projects with specified qualifiers "standard", "library" or "abstract", check that the project conforms to the qualifier. (Process_Project_Level_Simple_Attributes): Process new attribute Archive_Builder_Append_Option. * switch-m.adb: (Scan_Make_Switches): Process switch --subdirs= (Normalize_Compiler_Switches): Only keep compiler switches that are passed to gnat1 by the gcc driver and that are stored in the ALI file by gnat1. Do not take into account switc -save-temps * makegpr.adb (Compile_Link_With_Gnatmake): Transmit switch -eL if gprmake is called with -eL. (Scan_Arg): Recognize switch -eL (Usage): Add line for switch -eL * prj.adb (Initialize): Initialize Empty_File_Name (Project_Empty): New component Qualifier * prj-attr.ads, prj-attr.adb: New project level attribute Inherit_Source_Path. New project level attribute Archive_Builder_Append_Option * prj-dect.adb: Replace System.Strings by GNAT.Strings. * prj-ext.adb (Initialize_Project_Path): In Multi_Language mode, add /lib/gnat in the project path, after /share/gpr, for upward compatibility. * prj-part.adb (Project_Path_Name_Of.Try_Path): In high verbosity, put each Trying ..." on different lines. (Parse_Single_Project): Recognize project qualifiers. Fail in qualifier is "configuration" when not in configuration. Fail when in configuration when a specified qualifier is other than "configuration". * prj-proc.adb (Process_Declarative_Items): Link new elements of copied full associative array together. (Recursive_Process): Put the project qualifier in the project data * prj-tree.ads, prj-tree.adb: (Project_Qualifier_Of): New function (Set_Project_Qualifier_Of): New procedure From-SVN: r134023 --- gcc/ada/clean.adb | 27 +++- gcc/ada/gnatcmd.adb | 111 ++++++++++----- gcc/ada/gnatname.adb | 18 ++- gcc/ada/makegpr.adb | 23 +++- gcc/ada/makeusg.adb | 7 +- gcc/ada/prj-attr.adb | 9 +- gcc/ada/prj-attr.ads | 10 +- gcc/ada/prj-dect.adb | 6 +- gcc/ada/prj-ext.adb | 24 ++-- gcc/ada/prj-nmsc.adb | 321 ++++++++++++++++++++++++++++++++----------- gcc/ada/prj-part.adb | 64 ++++++++- gcc/ada/prj-proc.adb | 20 ++- gcc/ada/prj-tree.adb | 38 +++++ gcc/ada/prj-tree.ads | 16 ++- gcc/ada/prj.adb | 163 +++++++++++----------- gcc/ada/prj.ads | 194 ++++++++++++++++---------- gcc/ada/switch-m.adb | 80 +++++++++-- 17 files changed, 813 insertions(+), 318 deletions(-) diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index bbe84edf61b..876ec5a19a3 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2008, 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- -- @@ -1669,6 +1669,18 @@ package body Clean is end if; case Arg (2) is + when '-' => + if Arg'Length > Subdirs_Option'Length and then + Arg (1 .. Subdirs_Option'Length) = Subdirs_Option + then + Subdirs := + new String' + (Arg (Subdirs_Option'Length + 1 .. Arg'Last)); + + else + Bad_Argument; + end if; + when 'a' => if Arg'Length < 4 then Bad_Argument; @@ -1725,6 +1737,14 @@ package body Clean is end; end if; + when 'e' => + if Arg = "-eL" then + Follow_Links_For_Files := True; + + else + Bad_Argument; + end if; + when 'f' => Force_Deletions := True; @@ -1954,8 +1974,13 @@ package body Clean is Put_Line (" names may be omitted if -P is specified"); New_Line; + Put_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs"); + New_Line; + Put_Line (" -c Only delete compiler generated files"); Put_Line (" -D dir Specify dir as the object library"); + Put_Line (" -eL Follow symbolic links when processing " & + "project files"); Put_Line (" -f Force deletions of unwritable files"); Put_Line (" -F Full project path name " & "in brief error messages"); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 13ddf63f8d4..8135bfc8a4d 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2008, 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- -- @@ -41,6 +41,7 @@ with Prj.Util; use Prj.Util; with Sinput.P; with Snames; use Snames; with Table; +with Targparm; with Tempdir; with Types; use Types; with Hostparm; use Hostparm; @@ -233,7 +234,8 @@ procedure GNATCmd is -- METRIC). procedure Delete_Temp_Config_Files; - -- Delete all temporary config files + -- Delete all temporary config files. The caller is responsible for + -- ensuring that Keep_Temporary_Files is False. procedure Get_Closure; -- Get the sources in the closure of the ASIS_Main and add them to the @@ -721,38 +723,40 @@ procedure GNATCmd is pragma Warnings (Off, Success); begin - if not Keep_Temporary_Files then - if Project /= No_Project then - for Prj in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - if - Project_Tree.Projects.Table (Prj).Config_File_Temp - then - if Verbose_Mode then - Output.Write_Str ("Deleting temp configuration file """); - Output.Write_Str - (Get_Name_String - (Project_Tree.Projects.Table - (Prj).Config_File_Name)); - Output.Write_Line (""""); - end if; + -- This should only be called if Keep_Temporary_Files is False - Delete_File - (Name => Get_Name_String + pragma Assert (not Keep_Temporary_Files); + + if Project /= No_Project then + for Prj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + if + Project_Tree.Projects.Table (Prj).Config_File_Temp + then + if Verbose_Mode then + Output.Write_Str ("Deleting temp configuration file """); + Output.Write_Str + (Get_Name_String (Project_Tree.Projects.Table - (Prj).Config_File_Name), - Success => Success); + (Prj).Config_File_Name)); + Output.Write_Line (""""); end if; - end loop; - end if; - -- If a temporary text file that contains a list of files for a tool - -- has been created, delete this temporary file. + Delete_File + (Name => + Get_Name_String + (Project_Tree.Projects.Table (Prj).Config_File_Name), + Success => Success); + end if; + end loop; + end if; - if Temp_File_Name /= null then - Delete_File (Temp_File_Name.all, Success); - end if; + -- If a temporary text file that contains a list of files for a tool + -- has been created, delete this temporary file. + + if Temp_File_Name /= null then + Delete_File (Temp_File_Name.all, Success); end if; end Delete_Temp_Config_Files; @@ -770,7 +774,8 @@ procedure GNATCmd is 6 => new String'("-bargs"), 7 => new String'("-R"), 8 => new String'("-Z")); - -- Arguments of the invocation of gnatmake to get the list of + -- Arguments for the invocation of gnatmake which are added to the + -- Last_Arguments list by this procedure. FD : File_Descriptor; -- File descriptor for the temp file that will get the output of the @@ -793,6 +798,8 @@ procedure GNATCmd is File : Ada.Text_IO.File_Type; Line : String (1 .. 250); Last : Natural; + -- Used to read file if there is an error, it is good enough to display + -- just 250 characters if the first line of the file is very long. Udata : Unit_Data; Path : Path_Name_Type; @@ -890,7 +897,6 @@ procedure GNATCmd is if not Keep_Temporary_Files then Delete (File); - else Close (File); end if; @@ -1322,9 +1328,15 @@ procedure GNATCmd is for C in Command_List'Range loop if not Command_List (C).VMS_Only then - Put ("gnat " & To_Lower (Command_List (C).Cname.all)); + if Targparm.AAMP_On_Target then + Put ("gnaampcmd "); + else + Put ("gnat "); + end if; + + Put (To_Lower (Command_List (C).Cname.all)); Set_Col (25); - Put (Command_List (C).Unixcmd.all); + Put (Program_Name (Command_List (C).Unixcmd.all).all); declare Sws : Argument_List_Access renames Command_List (C).Unixsws; @@ -1375,6 +1387,16 @@ begin 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. + + Add_Default_Search_Dirs; + + -- Get target parameters so that AAMP_On_Target will be set, for testing in + -- Osint.Program_Name to handle the mapping of GNAAMP tool names. + + Targparm.Get_Target_Parameters; + -- Add the directory where the GNAT driver is invoked in front of the path, -- if the GNAT driver is invoked with directory information. Do not do this -- for VMS, where the notion of path does not really exist. @@ -1666,9 +1688,23 @@ begin end if; end if; + -- --subdirs=... Specify Subdirs + + if Argv'Length > Subdirs_Option'Length and then + Argv + (Argv'First .. Argv'First + Subdirs_Option'Length - 1) = + Subdirs_Option + then + Subdirs := + new String' + (Argv + (Argv'First + Subdirs_Option'Length .. Argv'Last)); + + Remove_Switch (Arg_Num); + -- -aPdir Add dir to the project search path - if Argv'Length > 3 + elsif Argv'Length > 3 and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP" then Add_Search_Project_Directory @@ -1676,6 +1712,13 @@ begin Remove_Switch (Arg_Num); + -- -eL Follow links for files + + elsif Argv.all = "-eL" then + Follow_Links_For_Files := True; + + Remove_Switch (Arg_Num); + -- -vPx Specify verbosity while parsing project files elsif Argv'Length = 4 diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index 06ef1f27e98..299e682bdc5 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -27,6 +27,7 @@ with Hostparm; with Opt; with Osint; use Osint; with Output; use Output; +with Prj; use Prj; with Prj.Makr; with Switch; use Switch; with Table; @@ -194,10 +195,15 @@ procedure Gnatname is -- Scan options first loop - case Getopt ("c: d: gnatep=! gnatep! gnateD! D: h P: v x: f:") is + case Getopt + ("-subdirs=! c: d: gnatep=! gnatep! gnateD! eL D: h P: v x: f:") + is when ASCII.NUL => exit; + when '-' => + Subdirs := new String'(Parameter); + when 'c' => if File_Set then Fail ("only one -P or -c switch may be specified"); @@ -213,6 +219,9 @@ procedure Gnatname is when 'D' => Get_Directories (Parameter); + when 'e' => + Opt.Follow_Links_For_Files := True; + when 'f' => Foreign_Patterns.Increment_Last; Foreign_Patterns.Table (Foreign_Patterns.Last) := @@ -286,10 +295,15 @@ procedure Gnatname is Write_Eol; Write_Line ("switches:"); + Write_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs"); + Write_Eol; + Write_Line (" -cfile create configuration pragmas file"); Write_Line (" -ddir use dir as one of the source " & "directories"); Write_Line (" -Dfile get source directories from file"); + Write_Line (" -eL follow symbolic links when processing " & + "project files"); Write_Line (" -fpat foreign pattern"); Write_Line (" -gnateDsym=v preprocess with symbol definition"); Write_Line (" -gnatep=data preprocess files with data file"); diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index 2d655e148fe..684cae99eb8 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2008, 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- -- @@ -283,6 +283,8 @@ package body Makegpr is Dash_cargs : constant String_Access := Dash_cargs_String'Access; Dash_d_String : aliased String := "-d"; Dash_d : constant String_Access := Dash_d_String'Access; + Dash_eL_String : aliased String := "-eL"; + Dash_eL : constant String_Access := Dash_eL_String'Access; Dash_f_String : aliased String := "-f"; Dash_f : constant String_Access := Dash_f_String'Access; Dash_k_String : aliased String := "-k"; @@ -2609,6 +2611,12 @@ package body Makegpr is Add_Argument (Dash_d, True); end if; + -- -eL + + if Follow_Links_For_Files then + Add_Argument (Dash_eL, True); + end if; + -- -k if Keep_Going then @@ -3375,8 +3383,8 @@ package body Makegpr is -- Add the directory where gprmake is invoked in front of the path, -- if gprmake is invoked from a bin directory or with directory - -- information. Only do this if the platform is not VMS, - -- where the notion of path does not really exist. + -- information. Only do this if the platform is not VMS, where the + -- notion of path does not really exist. -- Below code shares nasty code duplication with make.adb code??? @@ -4231,6 +4239,9 @@ package body Makegpr is elsif Arg = "-d" then Display_Compilation_Progress := True; + elsif Arg = "-eL" then + Follow_Links_For_Files := True; + elsif Arg = "-f" then Force_Compilations := True; @@ -4370,6 +4381,12 @@ package body Makegpr is Write_Str (" -c Compile only"); Write_Eol; + -- Line for -eL + + Write_Str (" -eL Follow symbolic links when processing " & + "project files"); + Write_Eol; + -- Line for -f Write_Str (" -f Force recompilations"); diff --git a/gcc/ada/makeusg.adb b/gcc/ada/makeusg.adb index 4178b1269ce..ca22dceec9c 100644 --- a/gcc/ada/makeusg.adb +++ b/gcc/ada/makeusg.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -306,6 +306,11 @@ begin Write_Str (" --RTS=dir specify the default source and object search" & " path"); Write_Eol; + + -- Line for --subdirs= + + Write_Str (" --subdirs=dir real obj/lib/exec dirs are subdirs"); + Write_Eol; Write_Eol; -- General Compiler, Binder, Linker switches diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index c340b293244..d3ff283ada2 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -25,10 +25,13 @@ with Osint; with Prj.Com; use Prj.Com; -with System.Case_Util; use System.Case_Util; + +with GNAT.Case_Util; use GNAT.Case_Util; package body Prj.Attr is + use GNAT; + -- Data for predefined attributes and packages -- Names are in lower case and end with '#' @@ -74,6 +77,7 @@ package body Prj.Attr is "SVobject_dir#" & "SVexec_dir#" & "LVsource_dirs#" & + "Lainherit_source_path#" & "LVexcluded_source_dirs#" & -- Source files @@ -114,6 +118,7 @@ package body Prj.Attr is -- Configuration - Archives "LVarchive_builder#" & + "LVarchive_builder_append_option#" & "LVarchive_indexer#" & "SVarchive_suffix#" & "LVlibrary_partial_linker#" & diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads index fd615b08604..473ea53dd8c 100644 --- a/gcc/ada/prj-attr.ads +++ b/gcc/ada/prj-attr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -28,14 +28,13 @@ -- It is also possible to define new packages with their attributes -with System.Strings; with Table; -package Prj.Attr is +with GNAT.Strings; - use System; +package Prj.Attr is - function Package_Name_List return Strings.String_List; + function Package_Name_List return GNAT.Strings.String_List; -- Returns the list of valid package names, including those added by -- procedures Register_New_Package below. The String_Access components of -- the returned String_List should never be freed. @@ -55,6 +54,7 @@ package Prj.Attr is -- Characteristics of an attribute. Optional_Index indicates that there -- may be an optional index in the index of the associative array, as in -- for Switches ("files.ada" at 2) use ... + -- Above character literals should be documented ??? subtype Defined_Attribute_Kind is Attribute_Kind range Single .. Optional_Index_Case_Insensitive_Associative_Array; diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 5fb13eaa27f..593874fad02 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -37,11 +37,11 @@ with Prj.Tree; use Prj.Tree; with Snames; with Uintp; use Uintp; -with System.Strings; +with GNAT.Strings; package body Prj.Dect is - use System; + use GNAT; type Zone is (In_Project, In_Package, In_Case_Construction); -- Used to indicate if we are parsing a package (In_Package), diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 384fe104cb2..5a7e9b97896 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2008, 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- -- @@ -260,19 +260,17 @@ package body Prj.Ext is Prefix := new String'(Executable_Prefix_Path); if Prefix.all /= "" then - if Get_Mode = Ada_Only then - Current_Project_Path := - new String'(Name_Buffer (1 .. Name_Len) & - Path_Separator & - Prefix.all & Directory_Separator & "gnat"); - - else - Current_Project_Path := - new String'(Name_Buffer (1 .. Name_Len) & - Path_Separator & - Prefix.all & Directory_Separator & - "share" & Directory_Separator & "gpr"); + if Get_Mode = Multi_Language then + Add_Str_To_Name_Buffer + (Path_Separator & Prefix.all & + Directory_Separator & "share" & + Directory_Separator & "gpr"); end if; + + Add_Str_To_Name_Buffer + (Path_Separator & Prefix.all & + Directory_Separator & "lib" & + Directory_Separator & "gnat"); end if; else diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index f5ff22b84cc..a3e9806bf17 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2008, 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- -- @@ -610,7 +610,7 @@ package body Prj.Nmsc is Src_Data : Source_Data := No_Source_Data; begin - -- This is a new source. Create an entry for it in the Sources table. + -- This is a new source so create an entry for it in the Sources table Source_Data_Table.Increment_Last (In_Tree.Sources); Id := Source_Data_Table.Last (In_Tree.Sources); @@ -619,34 +619,41 @@ package body Prj.Nmsc is Write_Str ("Adding source #"); Write_Str (Id'Img); Write_Str (", File : "); + Write_Str (Get_Name_String (File_Name)); if Lang_Kind = Unit_Based then Write_Str (", Unit : "); Write_Str (Get_Name_String (Unit)); end if; - Write_Line (Get_Name_String (File_Name)); + Write_Eol; end if; Src_Data.Project := Project; Src_Data.Language_Name := Lang; Src_Data.Language := Lang_Id; Src_Data.Lang_Kind := Lang_Kind; + Src_Data.Compiled := In_Tree.Languages_Data.Table + (Lang_Id).Config.Compiler_Driver /= + Empty_File_Name; Src_Data.Kind := Kind; Src_Data.Alternate_Languages := Alternate_Languages; Src_Data.Other_Part := Other_Part; Src_Data.Unit := Unit; Src_Data.Index := Index; Src_Data.File := File_Name; - Src_Data.Object := Object_Name (File_Name); Src_Data.Display_File := Display_File; - Src_Data.Dependency := - In_Tree.Languages_Data.Table (Lang_Id).Config.Dependency_Kind; - Src_Data.Dep_Name := - Dependency_Name (File_Name, Src_Data.Dependency); - Src_Data.Switches := Switches_Name (File_Name); + Src_Data.Dependency := In_Tree.Languages_Data.Table + (Lang_Id).Config.Dependency_Kind; Src_Data.Naming_Exception := Naming_Exception; + if Src_Data.Compiled then + Src_Data.Object := Object_Name (File_Name); + Src_Data.Dep_Name := + Dependency_Name (File_Name, Src_Data.Dependency); + Src_Data.Switches := Switches_Name (File_Name); + end if; + if Path /= No_Path then Src_Data.Path := Path; Src_Data.Display_Path := Display_Path; @@ -732,6 +739,15 @@ package body Prj.Nmsc is Check_Programming_Languages (In_Tree, Project, Data); + if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then + Error_Msg + (Project, + In_Tree, + "an abstract project need to have no language, no sources or no " & + "source directories", + Data.Location); + end if; + -- Check configuration in multi language mode if Must_Check_Configuration then @@ -1475,14 +1491,6 @@ package body Prj.Nmsc is Get_Name_String (Element.Value.Value); - if Name_Len = 0 then - Error_Msg - (Project, - In_Tree, - "compiler driver name cannot be empty", - Element.Value.Location); - end if; - In_Tree.Languages_Data.Table (Lang_Index).Config.Compiler_Driver := File_Name_Type (Element.Value.Value); @@ -1893,6 +1901,20 @@ package body Prj.Nmsc is From_List => List, In_Tree => In_Tree); + elsif Attribute.Name = Name_Archive_Builder_Append_Option then + + -- Attribute Archive_Builder: the archive builder + -- (usually "ar") and its minimum options (usually "cr"). + + List := Attribute.Value.Values; + + if List /= Nil_String then + Put + (Into_List => Data.Config.Archive_Builder_Append_Option, + From_List => List, + In_Tree => In_Tree); + end if; + elsif Attribute.Name = Name_Archive_Indexer then -- Attribute Archive_Indexer: the optional archive @@ -2043,9 +2065,9 @@ package body Prj.Nmsc is Error_Msg (Project, In_Tree, - "invalid value """ & - Get_Name_String (Attribute.Value.Value) & - """ for Symbolic_Link_Supported", + "invalid value """ + & Get_Name_String (Attribute.Value.Value) + & """ for Symbolic_Link_Supported", Attribute.Value.Location); end; @@ -2069,29 +2091,24 @@ package body Prj.Nmsc is Attribute.Value.Location); end; - elsif - Attribute.Name = Name_Library_Auto_Init_Supported - then + elsif Attribute.Name = Name_Library_Auto_Init_Supported then declare pragma Unsuppress (All_Checks); begin Data.Config.Auto_Init_Supported := - Boolean'Value (Get_Name_String - (Attribute.Value.Value)); + Boolean'Value (Get_Name_String (Attribute.Value.Value)); exception when Constraint_Error => Error_Msg (Project, In_Tree, - "invalid value """ & - Get_Name_String (Attribute.Value.Value) & - """ for Library_Auto_Init_Supported", + "invalid value """ + & Get_Name_String (Attribute.Value.Value) + & """ for Library_Auto_Init_Supported", Attribute.Value.Location); end; - elsif - Attribute.Name = Name_Shared_Library_Minimum_Switches - then + elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then List := Attribute.Value.Values; if List /= Nil_String then @@ -2100,9 +2117,7 @@ package body Prj.Nmsc is In_Tree => In_Tree); end if; - elsif - Attribute.Name = Name_Library_Version_Switches - then + elsif Attribute.Name = Name_Library_Version_Switches then List := Attribute.Value.Values; if List /= Nil_String then @@ -2126,6 +2141,7 @@ package body Prj.Nmsc is Current_Array : Array_Data; Element_Id : Array_Element_Id; Element : Array_Element; + List : String_List_Id; begin -- Process the associative array attributes at project level @@ -2144,6 +2160,19 @@ package body Prj.Nmsc is if Lang_Index /= No_Language_Index then case Current_Array.Name is + when Name_Inherit_Source_Path => + List := Element.Value.Values; + + if List /= Nil_String then + Put + (Into_List => + In_Tree.Languages_Data.Table (Lang_Index). + Config.Include_Compatible_Languages, + From_List => List, + In_Tree => In_Tree, + Lower_Case => True); + end if; + when Name_Toolchain_Description => -- Attribute Toolchain_Description () @@ -2613,6 +2642,14 @@ package body Prj.Nmsc is end if; end if; + -- A virtual project extending an externally built project is itself + -- externally built. + + if Data.Virtual and then Data.Extends /= No_Project then + Data.Externally_Built := + In_Tree.Projects.Table (Data.Extends).Externally_Built; + end if; + if Current_Verbosity = High then Write_Str ("Project is "); @@ -2946,12 +2983,12 @@ package body Prj.Nmsc is else Error_Msg_Name_1 := Unit; - + Error_Msg_Name_2 := + In_Tree.Projects.Table (Other_Project).Name; Error_Msg (Project, In_Tree, - "unit%% cannot belong to two projects " & - "simultaneously", + "%% is already a source of project %%", Element.Value.Location); end if; end if; @@ -3534,6 +3571,8 @@ package body Prj.Nmsc is Support_For_Libraries : Library_Support; + Library_Directory_Present : Boolean; + procedure Check_Library (Proj : Project_Id; Extends : Boolean); -- Check if an imported or extended project if also a library project @@ -3543,17 +3582,30 @@ package body Prj.Nmsc is procedure Check_Library (Proj : Project_Id; Extends : Boolean) is Proj_Data : Project_Data; + Src_Id : Source_Id; + Src : Source_Data; begin if Proj /= No_Project then Proj_Data := In_Tree.Projects.Table (Proj); if not Proj_Data.Library then + -- The only not library projects that are OK are those that - -- have no sources. + -- have no sources. However, header files from non-Ada + -- languages are OK, as there is nothing to compile. + + Src_Id := Proj_Data.First_Source; + while Src_Id /= No_Source loop + Src := In_Tree.Sources.Table (Src_Id); + + exit when Src.Lang_Kind /= File_Based + or else Src.Kind /= Spec; - if Proj_Data.Source_Dirs /= Nil_String then + Src_Id := Src.Next_In_Project; + end loop; + if Src_Id /= No_Source then Error_Msg_Name_1 := Data.Name; Error_Msg_Name_2 := Proj_Data.Name; @@ -3608,6 +3660,8 @@ package body Prj.Nmsc is -- Start of processing for Check_Library_Attributes begin + Library_Directory_Present := Lib_Dir.Value /= Empty_String; + -- Special case of extending project if Data.Extends /= No_Project then @@ -3621,17 +3675,34 @@ package body Prj.Nmsc is -- directory is specified. if Extended_Data.Library then - if Lib_Name.Default then - Data.Library_Name := Extended_Data.Library_Name; - end if; + if Data.Qualifier = Standard then + Error_Msg + (Project, In_Tree, + "a standard project cannot extend a library project", + Data.Location); - if Lib_Dir.Default then - if not Data.Virtual then - Error_Msg - (Project, In_Tree, - "a project extending a library project must " & - "specify an attribute Library_Dir", - Data.Location); + else + if Lib_Name.Default then + Data.Library_Name := Extended_Data.Library_Name; + end if; + + if Lib_Dir.Default then + if not Data.Virtual then + Error_Msg + (Project, In_Tree, + "a project extending a library project must " & + "specify an attribute Library_Dir", + Data.Location); + + else + -- For a virtual project extending a library project, + -- inherit library directory. + + Data.Library_Dir := Extended_Data.Library_Dir; + Data.Display_Library_Dir := + Extended_Data.Display_Library_Dir; + Library_Directory_Present := True; + end if; end if; end if; end if; @@ -3662,24 +3733,26 @@ package body Prj.Nmsc is pragma Assert (Lib_Dir.Kind = Single); - if Lib_Dir.Value = Empty_String then + if not Library_Directory_Present then if Current_Verbosity = High then Write_Line ("No library directory"); end if; else - -- Find path name, check that it is a directory + -- Find path name (unless inherited), check that it is a directory - Locate_Directory - (Project, - In_Tree, - File_Name_Type (Lib_Dir.Value), - Data.Display_Directory, - Data.Library_Dir, - Data.Display_Library_Dir, - Create => "library", - Current_Dir => Current_Dir, - Location => Lib_Dir.Location); + if Data.Library_Dir = No_Path then + Locate_Directory + (Project, + In_Tree, + File_Name_Type (Lib_Dir.Value), + Data.Display_Directory, + Data.Library_Dir, + Data.Display_Library_Dir, + Create => "library", + Current_Dir => Current_Dir, + Location => Lib_Dir.Location); + end if; if Data.Library_Dir = No_Path then @@ -3817,6 +3890,30 @@ package body Prj.Nmsc is and then Data.Library_Name /= No_Name; + if Data.Extends = No_Project then + case Data.Qualifier is + when Standard => + if Data.Library then + Error_Msg + (Project, In_Tree, + "a standard project cannot be a library project", + Lib_Name.Location); + end if; + + when Library => + if not Data.Library then + Error_Msg + (Project, In_Tree, + "not a library project", + Data.Location); + end if; + + when others => + null; + + end case; + end if; + if Data.Library then if Get_Mode = Multi_Language then Support_For_Libraries := Data.Config.Lib_Support; @@ -4426,6 +4523,14 @@ package body Prj.Nmsc is if Current = Nil_String then Data.Source_Dirs := Nil_String; + if Data.Qualifier = Standard then + Error_Msg + (Project, + In_Tree, + "a standard project cannot have no language declared", + Languages.Location); + end if; + else -- Look through all the languages specified in attribute -- Languages. @@ -6259,6 +6364,20 @@ package body Prj.Nmsc is end if; end if; end if; + + elsif Subdirs /= null then + Name_Len := 1; + Name_Buffer (1) := '.'; + Locate_Directory + (Project, + In_Tree, + Name_Find, + Data.Display_Directory, + Data.Object_Directory, + Data.Display_Object_Dir, + Create => "object", + Location => Object_Dir.Location, + Current_Dir => Current_Dir); end if; if Current_Verbosity = High then @@ -6291,7 +6410,7 @@ package body Prj.Nmsc is Exec_Dir.Location); else - -- We check that the specified object directory does exist + -- We check that the specified exec directory does exist Locate_Directory (Project, @@ -6337,6 +6456,14 @@ package body Prj.Nmsc is then Data.Source_Dirs := Nil_String; + if Data.Qualifier = Standard then + Error_Msg + (Project, + In_Tree, + "a standard project cannot have no sources", + Source_Files.Location); + end if; + if Data.Extends = No_Project and then Data.Object_Directory = Data.Directory then @@ -6368,6 +6495,13 @@ package body Prj.Nmsc is end if; elsif Source_Dirs.Values = Nil_String then + if Data.Qualifier = Standard then + Error_Msg + (Project, + In_Tree, + "a standard project cannot have no source directories", + Source_Dirs.Location); + end if; -- If Source_Dirs is an empty string list, this means that this -- project contains no source. For projects that don't extend other @@ -6940,8 +7074,6 @@ package body Prj.Nmsc is Current_Dir : String; Location : Source_Ptr := No_Location) is - The_Name : String := Get_Name_String (Name); - The_Parent : constant String := Get_Name_String (Parent) & Directory_Separator; @@ -6950,18 +7082,35 @@ package body Prj.Nmsc is Full_Name : File_Name_Type; + The_Name : File_Name_Type; + begin + Get_Name_String (Name); + + -- Add Subdirs.all if it is a directory that may be created and + -- Subdirs is not null; + + if Create /= "" and then Subdirs /= null then + if Name_Buffer (Name_Len) /= Directory_Separator then + Add_Char_To_Name_Buffer (Directory_Separator); + end if; + + Add_Str_To_Name_Buffer (Subdirs.all); + end if; + -- Convert '/' to directory separator (for Windows) - for J in The_Name'Range loop - if The_Name (J) = '/' then - The_Name (J) := Directory_Separator; + for J in 1 .. Name_Len loop + if Name_Buffer (J) = '/' then + Name_Buffer (J) := Directory_Separator; end if; end loop; + The_Name := Name_Find; + if Current_Verbosity = High then Write_Str ("Locate_Directory ("""); - Write_Str (The_Name); + Write_Str (Get_Name_String (The_Name)); Write_Str (""", """); Write_Str (The_Parent); Write_Line (""")"); @@ -6970,14 +7119,14 @@ package body Prj.Nmsc is Dir := No_Path; Display := No_Path; - if Is_Absolute_Path (The_Name) then - Full_Name := Name; + if Is_Absolute_Path (Get_Name_String (The_Name)) then + Full_Name := The_Name; else Name_Len := 0; Add_Str_To_Name_Buffer (The_Parent (The_Parent'First .. The_Parent_Last)); - Add_Str_To_Name_Buffer (The_Name); + Add_Str_To_Name_Buffer (Get_Name_String (The_Name)); Full_Name := Name_Find; end if; @@ -6985,7 +7134,8 @@ package body Prj.Nmsc is Full_Path_Name : constant String := Get_Name_String (Full_Name); begin - if Setup_Projects and then Create'Length > 0 + if (Setup_Projects or else Subdirs /= null) + and then Create'Length > 0 and then not Is_Directory (Full_Path_Name) then begin @@ -7331,7 +7481,7 @@ package body Prj.Nmsc is and then Lang = Ada_Language_Index and then Data.Extends = No_Project then - -- We should have found at least one source. If not, report an error. + -- We should have found at least one source, if not report an error if Data.Ada_Sources = Nil_String then Report_No_Sources @@ -7979,8 +8129,10 @@ package body Prj.Nmsc is Kind => Kind); if Language = No_Language_Index then + + -- A file name in a list must be a source of a language + if Name_Loc.Found then - -- A file name in a list must be a source of a language. Error_Msg_File_1 := File_Name; Error_Msg (Project, @@ -8045,9 +8197,24 @@ package body Prj.Nmsc is Error_Msg_Name_1 := Unit; Error_Msg (Project, In_Tree, - "unit %% cannot belong to " & - "several projects", + "unit %% cannot belong to several projects", No_Location); + + Error_Msg_Name_1 := In_Tree.Projects.Table (Project).Name; + Error_Msg_Name_2 := Name_Id (Display_Path_Id); + Error_Msg + (Project, In_Tree, + "\ project %%, %%", + No_Location); + + Error_Msg_Name_1 := + In_Tree.Projects.Table (Src_Data.Project).Name; + Error_Msg_Name_2 := Name_Id (Src_Data.Display_Path); + Error_Msg + (Project, In_Tree, + "\ project %%, %%", + No_Location); + Add_Src := False; end if; end if; @@ -8847,7 +9014,7 @@ package body Prj.Nmsc is Err_Vars.Error_Msg_Name_1 := Unit_Name; Error_Msg - (Project, In_Tree, "duplicate source %%", The_Location); + (Project, In_Tree, "duplicate unit %%", The_Location); Err_Vars.Error_Msg_Name_1 := In_Tree.Projects.Table diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index a7864c5df81..00f3c32ba3c 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -945,6 +945,9 @@ package body Prj.Part is Project_Comment_State : Tree.Comment_State; + Proj_Qualifier : Project_Qualifier := Unspecified; + Qualifier_Location : Source_Ptr; + begin Extends_All := False; @@ -1119,8 +1122,63 @@ package body Prj.Part is Project_Stack.Table (Project_Stack.Last).Id := Project; Set_Directory_Of (Project, In_Tree, Project_Directory); Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name); - Set_Location_Of (Project, In_Tree, Token_Ptr); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); + + -- Check if there is a qualifier before the reserved word "project" + + Qualifier_Location := Token_Ptr; + + if Token = Tok_Abstract then + Proj_Qualifier := Dry; + Scan (In_Tree); + + elsif Token = Tok_Identifier then + case Token_Name is + when Snames.Name_Standard => + Proj_Qualifier := Standard; + Scan (In_Tree); + + when Snames.Name_Aggregate => + Proj_Qualifier := Aggregate; + Scan (In_Tree); + + if Token = Tok_Identifier and then + Token_Name = Snames.Name_Library + then + Proj_Qualifier := Aggregate_Library; + Scan (In_Tree); + end if; + + when Snames.Name_Library => + Proj_Qualifier := Library; + Scan (In_Tree); + + when Snames.Name_Configuration => + if not In_Configuration then + Error_Msg ("configuration projects cannot belong to a user" & + " project tree", + Token_Ptr); + end if; + + Scan (In_Tree); + + when others => + null; + end case; + end if; + + if Proj_Qualifier /= Unspecified then + if In_Configuration then + Error_Msg ("a configuration project cannot be qualified except " & + "as configuration project", + Qualifier_Location); + end if; + + Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier); + end if; + + Set_Location_Of (Project, In_Tree, Token_Ptr); + Expect (Tok_Project, "PROJECT"); -- Mark location of PROJECT token if present @@ -1780,7 +1838,7 @@ package body Prj.Part is begin if Current_Verbosity = High then Write_Str (" Trying "); - Write_Str (Path); + Write_Line (Path); end if; return Locate_Regular_File diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index c0554223a31..638bf18ca48 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -1621,8 +1621,11 @@ package body Prj.Proc is if Next_Element = No_Array_Element then Array_Element_Table.Increment_Last (In_Tree.Array_Elements); - New_Element := Array_Element_Table.Last - (In_Tree.Array_Elements); + New_Element := + Array_Element_Table.Last + (In_Tree.Array_Elements); + In_Tree.Array_Elements.Table + (Prev_Element).Next := New_Element; else New_Element := Next_Element; @@ -1636,8 +1639,7 @@ package body Prj.Proc is In_Tree.Array_Elements.Table (New_Element) := - In_Tree.Array_Elements.Table - (Orig_Element); + In_Tree.Array_Elements.Table (Orig_Element); In_Tree.Array_Elements.Table (New_Element).Value.Project := Project; @@ -1872,9 +1874,7 @@ package body Prj.Proc is else In_Tree.Variable_Elements.Table - (The_Variable).Value := - New_Value; - + (The_Variable).Value := New_Value; end if; -- Associative array attribute @@ -2524,7 +2524,11 @@ package body Prj.Proc is Processed_Projects.Set (Name, Project); Processed_Data.Name := Name; + Processed_Data.Qualifier := + Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree); In_Tree.Projects.Table (Project).Name := Name; + In_Tree.Projects.Table (Project).Qualifier := + Processed_Data.Qualifier; Get_Name_String (Name); @@ -2786,6 +2790,8 @@ package body Prj.Proc is end if; end if; end; + + In_Tree.Projects.Table (Project) := Processed_Data; end if; -- Process limited withed projects diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index db32e4a0a07..83ee5f936b6 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -108,6 +108,7 @@ package body Prj.Tree is In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment_Zones, + Qualifier => Unspecified, Expr_Kind => Undefined, Location => No_Location, Directory => No_Path, @@ -153,6 +154,7 @@ package body Prj.Tree is In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment, + Qualifier => Unspecified, Expr_Kind => Undefined, Flag1 => Comments.Table (J).Follows_Empty_Line, Flag2 => @@ -321,6 +323,7 @@ package body Prj.Tree is Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); In_Tree.Project_Nodes.Table (Zone) := (Kind => N_Comment_Zones, + Qualifier => Unspecified, Location => No_Location, Directory => No_Path, Expr_Kind => Undefined, @@ -395,6 +398,7 @@ package body Prj.Tree is In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => Of_Kind, + Qualifier => Unspecified, Location => No_Location, Directory => No_Path, Expr_Kind => And_Expr_Kind, @@ -429,6 +433,7 @@ package body Prj.Tree is In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment_Zones, + Qualifier => Unspecified, Expr_Kind => Undefined, Location => No_Location, Directory => No_Path, @@ -458,6 +463,7 @@ package body Prj.Tree is In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment, + Qualifier => Unspecified, Expr_Kind => Undefined, Flag1 => Comments.Table (J).Follows_Empty_Line, Flag2 => @@ -1352,6 +1358,22 @@ package body Prj.Tree is return In_Tree.Project_Nodes.Table (Node).Field2; end Project_Declaration_Of; + -------------------------- + -- Project_Qualifier_Of -- + -------------------------- + + function Project_Qualifier_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Qualifier + is + begin + pragma Assert + (Node /= Empty_Node + and then + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + return In_Tree.Project_Nodes.Table (Node).Qualifier; + end Project_Qualifier_Of; + ------------------------------------------- -- Project_File_Includes_Unkept_Comments -- ------------------------------------------- @@ -2467,6 +2489,22 @@ package body Prj.Tree is In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Project_Declaration_Of; + ------------------------------ + -- Set_Project_Qualifier_Of -- + ------------------------------ + + procedure Set_Project_Qualifier_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Qualifier) + is + begin + pragma Assert + (Node /= Empty_Node + and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + In_Tree.Project_Nodes.Table (Node).Qualifier := To; + end Set_Project_Qualifier_Of; + ----------------------------------------------- -- Set_Project_File_Includes_Unkept_Comments -- ----------------------------------------------- diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index 19d600f4f6c..9649adddec8 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -344,6 +344,12 @@ package Prj.Tree is pragma Inline (Project_Declaration_Of); -- Only valid for N_Project nodes + function Project_Qualifier_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Qualifier; + pragma Inline (Project_Qualifier_Of); + -- Only valid for N_Project nodes + function Extending_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; @@ -694,6 +700,12 @@ package Prj.Tree is To : Project_Node_Id); pragma Inline (Set_Project_Declaration_Of); + procedure Set_Project_Qualifier_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Qualifier); + pragma Inline (Set_Project_Qualifier_Of); + procedure Set_Extending_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; @@ -912,6 +924,8 @@ package Prj.Tree is Kind : Project_Node_Kind; + Qualifier : Project_Qualifier := Unspecified; + Location : Source_Ptr := No_Location; Directory : Path_Name_Type := No_Path; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index f5752161297..a362fb8bd22 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -88,84 +88,87 @@ package body Prj is Supp_Suffixes => No_Supp_Language_Index); Project_Empty : constant Project_Data := - (Externally_Built => False, - Config => Default_Project_Config, - Languages => No_Name_List, - First_Referred_By => No_Project, - Name => No_Name, - Display_Name => No_Name, - Path_Name => No_Path, - Display_Path_Name => No_Path, - Virtual => False, - Location => No_Location, - Mains => Nil_String, - Directory => No_Path, - Display_Directory => No_Path, - Dir_Path => null, - Library => False, - Library_Dir => No_Path, - Display_Library_Dir => No_Path, - Library_Src_Dir => No_Path, - Display_Library_Src_Dir => No_Path, - Library_ALI_Dir => No_Path, - Display_Library_ALI_Dir => No_Path, - Library_Name => No_Name, - Library_Kind => Static, - Lib_Internal_Name => No_Name, - Standalone_Library => False, - Lib_Interface_ALIs => Nil_String, - Lib_Auto_Init => False, - Libgnarl_Needed => Unknown, - Symbol_Data => No_Symbols, - Ada_Sources => Nil_String, - Sources => Nil_String, - First_Source => No_Source, - Last_Source => No_Source, - Unit_Based_Language_Name => No_Name, - Unit_Based_Language_Index => No_Language_Index, - Imported_Directories_Switches => null, - Include_Path => null, - Include_Data_Set => False, - Include_Language => No_Language_Index, - Source_Dirs => Nil_String, - Known_Order_Of_Source_Dirs => True, - Object_Directory => No_Path, - Display_Object_Dir => No_Path, - Library_TS => Empty_Time_Stamp, - Exec_Directory => No_Path, - Display_Exec_Dir => No_Path, - Extends => No_Project, - Extended_By => No_Project, - Naming => Std_Naming_Data, - First_Language_Processing => No_Language_Index, - Decl => No_Declarations, - Imported_Projects => Empty_Project_List, - All_Imported_Projects => Empty_Project_List, - Ada_Include_Path => null, - Ada_Objects_Path => null, - Objects_Path => null, - Include_Path_File => No_Path, - Objects_Path_File_With_Libs => No_Path, - Objects_Path_File_Without_Libs => No_Path, - Config_File_Name => No_Path, - Config_File_Temp => False, - Linker_Name => No_File, - Linker_Path => No_Path, - Minimum_Linker_Options => No_Name_List, - Config_Checked => False, - Checked => False, - Seen => False, - Need_To_Build_Lib => False, - Depth => 0, - Unkept_Comments => False, - Langs => No_Languages, - Supp_Languages => No_Supp_Language_Index, - Ada_Sources_Present => True, - Other_Sources_Present => True, - First_Other_Source => No_Other_Source, - Last_Other_Source => No_Other_Source, - First_Lang_Processing => Default_First_Language_Processing_Data, - Supp_Language_Processing => No_Supp_Language_Index); + (Qualifier => Unspecified, + Externally_Built => False, + Config => Default_Project_Config, + Languages => No_Name_List, + First_Referred_By => No_Project, + Name => No_Name, + Display_Name => No_Name, + Path_Name => No_Path, + Display_Path_Name => No_Path, + Virtual => False, + Location => No_Location, + Mains => Nil_String, + Directory => No_Path, + Display_Directory => No_Path, + Dir_Path => null, + Library => False, + Library_Dir => No_Path, + Display_Library_Dir => No_Path, + Library_Src_Dir => No_Path, + Display_Library_Src_Dir => No_Path, + Library_ALI_Dir => No_Path, + Display_Library_ALI_Dir => No_Path, + Library_Name => No_Name, + Library_Kind => Static, + Lib_Internal_Name => No_Name, + Standalone_Library => False, + Lib_Interface_ALIs => Nil_String, + Lib_Auto_Init => False, + Libgnarl_Needed => Unknown, + Symbol_Data => No_Symbols, + Ada_Sources => Nil_String, + Sources => Nil_String, + First_Source => No_Source, + Last_Source => No_Source, + Unit_Based_Language_Name => No_Name, + Unit_Based_Language_Index => No_Language_Index, + Imported_Directories_Switches => null, + Include_Path => null, + Include_Data_Set => False, + Include_Language => No_Language_Index, + Source_Dirs => Nil_String, + Known_Order_Of_Source_Dirs => True, + Object_Directory => No_Path, + Display_Object_Dir => No_Path, + Library_TS => Empty_Time_Stamp, + Exec_Directory => No_Path, + Display_Exec_Dir => No_Path, + Extends => No_Project, + Extended_By => No_Project, + Naming => Std_Naming_Data, + First_Language_Processing => No_Language_Index, + Decl => No_Declarations, + Imported_Projects => Empty_Project_List, + All_Imported_Projects => Empty_Project_List, + Ada_Include_Path => null, + Ada_Objects_Path => null, + Objects_Path => null, + Include_Path_File => No_Path, + Objects_Path_File_With_Libs => No_Path, + Objects_Path_File_Without_Libs => No_Path, + Config_File_Name => No_Path, + Config_File_Temp => False, + Linker_Name => No_File, + Linker_Path => No_Path, + Minimum_Linker_Options => No_Name_List, + Config_Checked => False, + Checked => False, + Seen => False, + Need_To_Build_Lib => False, + Depth => 0, + Unkept_Comments => False, + Langs => No_Languages, + Supp_Languages => No_Supp_Language_Index, + Ada_Sources_Present => True, + Other_Sources_Present => True, + First_Other_Source => No_Other_Source, + Last_Other_Source => No_Other_Source, + First_Lang_Processing => + Default_First_Language_Processing_Data, + Supp_Language_Processing => + No_Supp_Language_Index); package Temp_Files is new Table.Table (Table_Component_Type => Path_Name_Type, @@ -626,6 +629,7 @@ package body Prj is 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; @@ -1418,7 +1422,6 @@ package body Prj is if Tree = No_Project_Tree then Prj.Initialize (Tree => No_Project_Tree); return Std_Naming_Data; - else return Tree.Private_Part.Default_Naming; end if; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 4f6f37f45b7..5b62ec9e017 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -43,6 +43,15 @@ with System.HTable; package Prj is + Subdirs_Option : constant String := "--subdirs="; + -- Switch used to indicate that the real directories (object, exec, + -- library, ...) are subdirectories of what is indicated in the project + -- file. + + Subdirs : String_Ptr := null; + -- The value after the equal sign in switch --subdirs=... + -- Contains the relative subdirectory. + type Library_Support is (None, Static_Only, Full); -- Support for Library Project File. -- - None: Library Project Files are not supported at all @@ -55,6 +64,23 @@ package Prj is -- Tri-state to decide if -lgnarl is needed when linking type Mode is (Multi_Language, Ada_Only); + -- Ada_Only: mode for gnatmake, gnatname, the GNAT driver + -- Multi_Language: mode for gprbuild, gprclean + + type Project_Qualifier is + (Unspecified, + Standard, + Library, + Dry, + Aggregate, + Aggregate_Library); + -- Qualifiers that can prefix the reserved word "project" in a project + -- file: + -- Standard: standard project ... + -- Library: library project is ... + -- Dry: abstract project is + -- Aggregate: aggregate project is + -- Aggregate_Library: aggregate library project is ... function Get_Mode return Mode; pragma Inline (Get_Mode); @@ -373,6 +399,12 @@ package Prj is Naming_Data : Lang_Naming_Data; -- The naming data for the languages (prefixes, etc.) + Include_Compatible_Languages : Name_List_Index := No_Name_List; + -- The list of languages that are "include compatible" with this + -- language. A language B (for example "C") is "include compatible" with + -- a language A (for example "C++") if it is expected that sources of + -- language A may "include" header files from language B. + Compiler_Driver : File_Name_Type := No_File; -- The name of the executable for the compiler of the language @@ -488,38 +520,39 @@ package Prj is -- Record describing the configuration of a language No_Language_Config : constant Language_Config := - (Kind => File_Based, - Naming_Data => No_Lang_Naming_Data, - Compiler_Driver => No_File, - Compiler_Driver_Path => null, - Compiler_Required_Switches => No_Name_List, - Compilation_PIC_Option => No_Name_List, - Runtime_Library_Dir => No_Name, - Mapping_File_Switches => No_Name_List, - Mapping_Spec_Suffix => No_File, - Mapping_Body_Suffix => No_File, - Config_File_Switches => No_Name_List, - Dependency_Kind => Makefile, - Dependency_Option => No_Name_List, - Compute_Dependency => No_Name_List, - Include_Option => No_Name_List, - Include_Path => No_Name, - Include_Path_File => No_Name, - Objects_Path => No_Name, - Objects_Path_File => No_Name, - Config_Body => No_Name, - Config_Spec => No_Name, - Config_Body_Pattern => No_Name, - Config_Spec_Pattern => No_Name, - Config_File_Unique => False, - Binder_Driver => No_File, - Binder_Driver_Path => No_Path, - Binder_Required_Switches => No_Name_List, - Binder_Prefix => No_Name, - Toolchain_Version => No_Name, - Toolchain_Description => No_Name, - PIC_Option => No_Name, - Objects_Generated => True); + (Kind => File_Based, + Naming_Data => No_Lang_Naming_Data, + Include_Compatible_Languages => No_Name_List, + Compiler_Driver => No_File, + Compiler_Driver_Path => null, + Compiler_Required_Switches => No_Name_List, + Compilation_PIC_Option => No_Name_List, + Runtime_Library_Dir => No_Name, + Mapping_File_Switches => No_Name_List, + Mapping_Spec_Suffix => No_File, + Mapping_Body_Suffix => No_File, + Config_File_Switches => No_Name_List, + Dependency_Kind => Makefile, + Dependency_Option => No_Name_List, + Compute_Dependency => No_Name_List, + Include_Option => No_Name_List, + Include_Path => No_Name, + Include_Path_File => No_Name, + Objects_Path => No_Name, + Objects_Path_File => No_Name, + Config_Body => No_Name, + Config_Spec => No_Name, + Config_Body_Pattern => No_Name, + Config_Spec_Pattern => No_Name, + Config_File_Unique => False, + Binder_Driver => No_File, + Binder_Driver_Path => No_Path, + Binder_Required_Switches => No_Name_List, + Binder_Prefix => No_Name, + Toolchain_Version => No_Name, + Toolchain_Description => No_Name, + PIC_Option => No_Name, + Objects_Generated => True); type Language_Data is record Name : Name_Id := No_Name; @@ -580,6 +613,9 @@ package Prj is Lang_Kind : Language_Kind := File_Based; -- Kind of the language + Compiled : Boolean := True; + -- False when there is no compiler for the language + Alternate_Languages : Alternate_Language_Id := No_Alternate_Language; -- List of languages a header file may also be, in addition of -- language Language_Name. @@ -640,40 +676,40 @@ package Prj is Object_Path : Path_Name_Type := No_Path; -- Object path of the real object file - Object_TS : Time_Stamp_Type := Empty_Time_Stamp; + Object_TS : Time_Stamp_Type := Empty_Time_Stamp; -- Object file time stamp - Dep_Name : File_Name_Type := No_File; + Dep_Name : File_Name_Type := No_File; -- Dependency file simple name - Current_Dep_Path : Path_Name_Type := No_Path; + Current_Dep_Path : Path_Name_Type := No_Path; -- Path name of an existing dependency file - Dep_Path : Path_Name_Type := No_Path; + Dep_Path : Path_Name_Type := No_Path; -- Path name of the real dependency file - Dep_TS : Time_Stamp_Type := Empty_Time_Stamp; + Dep_TS : Time_Stamp_Type := Empty_Time_Stamp; -- Dependency file time stamp - Switches : File_Name_Type := No_File; + Switches : File_Name_Type := No_File; -- File name of the switches file - Switches_Path : Path_Name_Type := No_Path; + Switches_Path : Path_Name_Type := No_Path; -- Path name of the switches file - Switches_TS : Time_Stamp_Type := Empty_Time_Stamp; + Switches_TS : Time_Stamp_Type := Empty_Time_Stamp; -- Switches file time stamp - Naming_Exception : Boolean := False; + Naming_Exception : Boolean := False; -- True if the source has an exceptional name - Next_In_Sources : Source_Id := No_Source; + Next_In_Sources : Source_Id := No_Source; -- Link to another source in the project tree - Next_In_Project : Source_Id := No_Source; + Next_In_Project : Source_Id := No_Source; -- Link to another source in the project - Next_In_Lang : Source_Id := No_Source; + Next_In_Lang : Source_Id := No_Source; -- Link to another source of the same language end record; @@ -682,6 +718,7 @@ package Prj is Language_Name => No_Name, Language => No_Language_Index, Lang_Kind => File_Based, + Compiled => True, Alternate_Languages => No_Alternate_Language, Kind => Spec, Dependency => None, @@ -1110,6 +1147,9 @@ package Prj is -- The name of the executable to build archives, with the minimum -- switches. Specified in the configuration. + Archive_Builder_Append_Option : Name_List_Index := No_Name_List; + -- The options to append object files to an archive + Archive_Indexer : Name_List_Index := No_Name_List; -- The name of the executable to index archives, with the minimum -- switches. Specified in the configuration. @@ -1149,26 +1189,27 @@ package Prj is end record; Default_Project_Config : constant Project_Configuration := - (Run_Path_Option => No_Name_List, - Executable_Suffix => No_Name, - Linker => No_Path, - Minimum_Linker_Options => No_Name_List, - Linker_Executable_Option => No_Name_List, - Linker_Lib_Dir_Option => No_Name, - Linker_Lib_Name_Option => No_Name, - Library_Builder => No_Path, - Lib_Support => None, - Archive_Builder => No_Name_List, - Archive_Indexer => No_Name_List, - Archive_Suffix => No_File, - Lib_Partial_Linker => No_Name_List, - Shared_Lib_Prefix => No_File, - Shared_Lib_Suffix => No_File, - Shared_Lib_Min_Options => No_Name_List, - Lib_Version_Options => No_Name_List, - Symbolic_Link_Supported => False, - Lib_Maj_Min_Id_Supported => False, - Auto_Init_Supported => False); + (Run_Path_Option => No_Name_List, + Executable_Suffix => No_Name, + Linker => No_Path, + Minimum_Linker_Options => No_Name_List, + Linker_Executable_Option => No_Name_List, + Linker_Lib_Dir_Option => No_Name, + Linker_Lib_Name_Option => No_Name, + Library_Builder => No_Path, + Lib_Support => None, + Archive_Builder => No_Name_List, + Archive_Builder_Append_Option => No_Name_List, + Archive_Indexer => No_Name_List, + Archive_Suffix => No_File, + Lib_Partial_Linker => No_Name_List, + Shared_Lib_Prefix => No_File, + Shared_Lib_Suffix => No_File, + Shared_Lib_Min_Options => No_Name_List, + Lib_Version_Options => No_Name_List, + Symbolic_Link_Supported => False, + Lib_Maj_Min_Id_Supported => False, + Auto_Init_Supported => False); -- The following record describes a project file representation @@ -1177,6 +1218,9 @@ package Prj is -- separator. type Project_Data is record + Qualifier : Project_Qualifier := Unspecified; + -- The eventual qualifier for this project + Externally_Built : Boolean := False; -- True if the project is externally built. In such case, the Project -- Manager will not modify anything in this project. @@ -1436,21 +1480,21 @@ package Prj is Supp_Languages : Supp_Language_Index := No_Supp_Language_Index; -- Indicate the different languages of the source of this project - Ada_Sources_Present : Boolean := True; + Ada_Sources_Present : Boolean := True; -- True if there are Ada sources in the project - Other_Sources_Present : Boolean := True; + Other_Sources_Present : Boolean := True; -- True if there are sources from languages other than Ada in the -- project. - First_Other_Source : Other_Source_Id := No_Other_Source; + First_Other_Source : Other_Source_Id := No_Other_Source; -- First source of a language other than Ada - Last_Other_Source : Other_Source_Id := No_Other_Source; + Last_Other_Source : Other_Source_Id := No_Other_Source; -- Last source of a language other than Ada - First_Lang_Processing : First_Language_Processing_Data := - Default_First_Language_Processing_Data; + First_Lang_Processing : First_Language_Processing_Data := + Default_First_Language_Processing_Data; Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index; -- Language configurations @@ -1740,8 +1784,12 @@ private -- normally forbidden for project names, there cannot be any name clash. Empty_Name : Name_Id; - -- Name_Id for an empty name (no characters). Initialized by the call - -- to procedure Initialize. + -- 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. procedure Add_To_Buffer (S : String; diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index 208bb38f886..20761f417cd 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -26,6 +26,7 @@ with Debug; use Debug; with Osint; use Osint; with Opt; use Opt; +with Prj; use Prj; with Prj.Ext; use Prj.Ext; with Table; @@ -150,20 +151,59 @@ package body Switch.M is when False => -- All switches that don't start with -gnat stay as is, - -- except -v, -E and -pg + -- except -pg, -Wall, -k8, -w - if Switch_Chars = "-pg" then + if Switch_Chars = "-pg" or else Switch_Chars = "-p" then -- The gcc driver converts -pg to -p, so that is what -- is stored in the ALI file. Add_Switch_Component ("-p"); - -- Do not take into account switches that are not transmitted - -- to gnat1 by the gcc driver. + elsif Switch_Chars = "-Wall" then - elsif C /= 'v' and then C /= 'E' then + -- The gcc driver adds -gnatwa when -Wall is used + + Add_Switch_Component ("-gnatwa"); + Add_Switch_Component ("-Wall"); + + elsif Switch_Chars = "-k8" then + + -- The gcc driver transforms -k8 into -gnatk8 + + Add_Switch_Component ("-gnatk8"); + + elsif Switch_Chars = "-w" then + + -- The gcc driver adds -gnatws when -w is used + + Add_Switch_Component ("-gnatws"); + Add_Switch_Component ("-w"); + + elsif Switch_Chars'Length > 6 + and then + Switch_Chars (Switch_Chars'First .. Switch_Chars'First + 5) + = "--RTS=" + then Add_Switch_Component (Switch_Chars); + + -- When --RTS=mtp is used, the gcc driver adds -mrtp + + if Switch_Chars = "--RTS=mtp" then + Add_Switch_Component ("-mrtp"); + end if; + + -- Take only into account switches that are transmitted to + -- gnat1 by the gcc driver and stored by gnat1 in the ALI file. + + else + case C is + when 'O' | 'W' | 'w' | 'f' | 'd' | 'g' | 'm' => + Add_Switch_Component (Switch_Chars); + + when others => + null; + end case; end if; return; @@ -332,7 +372,8 @@ package body Switch.M is Ptr := Ptr + 1; if Ptr <= Max - and then Switch_Chars (Ptr) = 's' then + and then Switch_Chars (Ptr) = 's' + then Last_Stored := Last_Stored + 1; Storing (Last_Stored) := 's'; Ptr := Ptr + 1; @@ -366,12 +407,9 @@ package body Switch.M is -- -gnatyMxxx - if C = 'M' and then - Storing (First_Stored) = 'y' - then + if C = 'M' and then Storing (First_Stored) = 'y' then Last_Stored := First_Stored + 1; Storing (Last_Stored) := 'M'; - while Ptr <= Max loop C := Switch_Chars (Ptr); exit when C not in '0' .. '9'; @@ -517,8 +555,24 @@ package body Switch.M is if Switch_Chars = "--create-missing-dirs" then Setup_Projects := True; - elsif Switch_Chars'Length > 3 and then - Switch_Chars (Ptr .. Ptr + 1) = "aP" + elsif Switch_Chars'Length > Subdirs_Option'Length + and then + Switch_Chars + (Switch_Chars'First .. + Switch_Chars'First + Subdirs_Option'Length - 1) = + Subdirs_Option + then + Subdirs := + new String' + (Switch_Chars + (Switch_Chars'First + Subdirs_Option'Length .. + Switch_Chars'Last)); + + elsif Switch_Chars (Ptr) = '-' then + Bad_Switch (Switch_Chars); + + elsif Switch_Chars'Length > 3 + and then Switch_Chars (Ptr .. Ptr + 1) = "aP" then Add_Search_Project_Directory (Switch_Chars (Ptr + 2 .. Switch_Chars'Last)); -- 2.30.2