Commit 68c3f02a by Vincent Celier Committed by Arnaud Charlet

clean.adb (Parse_Cmd_Line): Recognize switch --subdirs=

2008-04-08  Vincent Celier  <celier@adacore.com>

	* 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
	<prefix>/lib/gnat in the project path, after <prefix>/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
parent a1e2130c
......@@ -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<project> 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");
......
......@@ -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
......
......@@ -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");
......
......@@ -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");
......
......@@ -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
......
......@@ -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#" &
......
......@@ -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;
......
......@@ -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),
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 --
-----------------------------------------------
......
......@@ -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;
......
......@@ -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));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment