summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2005-03-29 16:18:31 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2005-03-29 16:18:31 +0000
commitef9889a300178094d3ccc4ac6d692f47012b56fb (patch)
tree642362f643779e9970b78af3b833e257bde2dedc
parent15c37a32819eaa1b861b6112ced8f6ed2867117c (diff)
downloadgcc-ef9889a300178094d3ccc4ac6d692f47012b56fb.tar.gz
2005-03-29 Vincent Celier <celier@adacore.com>
* prj.ads, prj.adb: (Project_Data): Add new component Display_Name * prj-part.adb (Parse_Single_Project): Set the location of a project on its defining identifier, rather than on the reserved word "project". * prj-proc.adb (Expression): Adapt to the fact that default of external references may be string expressions, not always literal strings. (Recursive_Process): Set Display_Name equal to Name when Location is No_Location, that is when there is no actual file. Get the Display_Name of the project from the source, when it is not a virtual project. (Process): Use the Display_Name in error messages * prj-strt.adb (External_Reference): Allow default to be string expressions, not only literal strings. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@97180 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/prj-part.adb2
-rw-r--r--gcc/ada/prj-proc.adb61
-rw-r--r--gcc/ada/prj-strt.adb52
-rw-r--r--gcc/ada/prj.adb4
-rw-r--r--gcc/ada/prj.ads103
5 files changed, 143 insertions, 79 deletions
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index 54d2812d7a6..1b100843b42 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -1068,8 +1068,8 @@ package body Prj.Part is
-- Mark location of PROJECT token if present
if Token = Tok_Project then
+ Scan (In_Tree); -- scan past PROJECT
Set_Location_Of (Project, In_Tree, Token_Ptr);
- Scan (In_Tree); -- scan past project
end if;
-- Clear the Buffer
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index ed3a8b91c16..7ccd5750cf3 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -33,6 +33,7 @@ with Prj.Attr; use Prj.Attr;
with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
+with Sinput; use Sinput;
with Snames;
with GNAT.Case_Util; use GNAT.Case_Util;
@@ -781,14 +782,31 @@ package body Prj.Proc is
Default : Name_Id := No_Name;
Value : Name_Id := No_Name;
+ Def_Var : Variable_Value;
+
Default_Node : constant Project_Node_Id :=
External_Default_Of
(The_Current_Term, From_Project_Node_Tree);
begin
+ -- If there is a default value for the external reference,
+ -- get its value.
+
if Default_Node /= Empty_Node then
- Default :=
- String_Value_Of (Default_Node, From_Project_Node_Tree);
+ Def_Var := Expression
+ (Project => Project,
+ In_Tree => In_Tree,
+ From_Project_Node => Default_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Pkg => Pkg,
+ First_Term =>
+ Tree.First_Term
+ (Default_Node, From_Project_Node_Tree),
+ Kind => Single);
+
+ if Def_Var /= Nil_Variable_Value then
+ Default := Def_Var.Value;
+ end if;
end if;
Value := Prj.Ext.Value_Of (Name, Default);
@@ -1057,11 +1075,12 @@ package body Prj.Proc is
Obj_Dir
then
if In_Tree.Projects.Table (Extending2).Virtual then
- Error_Msg_Name_1 := In_Tree.Projects.Table (Proj).Name;
+ Error_Msg_Name_1 :=
+ In_Tree.Projects.Table (Proj).Display_Name;
if Error_Report = null then
Error_Msg
- ("project % cannot be extended by a virtual " &
+ ("project { cannot be extended by a virtual " &
"project with the same object directory",
In_Tree.Projects.Table (Proj).Location);
else
@@ -1075,13 +1094,13 @@ package body Prj.Proc is
else
Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Extending2).Name;
+ In_Tree.Projects.Table (Extending2).Display_Name;
Error_Msg_Name_2 :=
- In_Tree.Projects.Table (Proj).Name;
+ In_Tree.Projects.Table (Proj).Display_Name;
if Error_Report = null then
Error_Msg
- ("project % cannot extend project %",
+ ("project { cannot extend project {",
In_Tree.Projects.Table (Extending2).Location);
Error_Msg
("\they share the same object directory",
@@ -2158,8 +2177,14 @@ package body Prj.Proc is
Processed_Data : Project_Data := Empty_Project (In_Tree);
Imported : Project_List := Empty_Project_List;
Declaration_Node : Project_Node_Id := Empty_Node;
+ Tref : Source_Buffer_Ptr;
Name : constant Name_Id :=
- Name_Of (From_Project_Node, From_Project_Node_Tree);
+ Name_Of
+ (From_Project_Node, From_Project_Node_Tree);
+ Location : Source_Ptr :=
+ Location_Of
+ (From_Project_Node, From_Project_Node_Tree);
+
begin
Project := Processed_Projects.Get (Name);
@@ -2184,6 +2209,26 @@ package body Prj.Proc is
Virtual_Prefix
then
Processed_Data.Virtual := True;
+ Processed_Data.Display_Name := Name;
+
+ -- If there is no file, for example when the project node tree is
+ -- built in memory by GPS, the Display_Name cannot be found in
+ -- the source, so its value is the same as Name.
+
+ elsif Location = No_Location then
+ Processed_Data.Display_Name := Name;
+
+ -- Get the spelling of the project name from the project file
+
+ else
+ Tref := Source_Text (Get_Source_File_Index (Location));
+
+ for J in 1 .. Name_Len loop
+ Name_Buffer (J) := Tref (Location);
+ Location := Location + 1;
+ end loop;
+
+ Processed_Data.Display_Name := Name_Find;
end if;
Processed_Data.Display_Path_Name :=
diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb
index ae7941c203b..91539e94083 100644
--- a/gcc/ada/prj-strt.adb
+++ b/gcc/ada/prj-strt.adb
@@ -106,8 +106,10 @@ package body Prj.Strt is
-- Add one single names to table Names
procedure External_Reference
- (In_Tree : Project_Node_Tree_Ref;
- External_Value : out Project_Node_Id);
+ (In_Tree : Project_Node_Tree_Ref;
+ Current_Project : Project_Node_Id;
+ Current_Package : Project_Node_Id;
+ External_Value : out Project_Node_Id);
-- Parse an external reference. Current token is "external".
procedure Attribute_Reference
@@ -341,8 +343,10 @@ package body Prj.Strt is
------------------------
procedure External_Reference
- (In_Tree : Project_Node_Tree_Ref;
- External_Value : out Project_Node_Id)
+ (In_Tree : Project_Node_Tree_Ref;
+ Current_Project : Project_Node_Id;
+ Current_Package : Project_Node_Id;
+ External_Value : out Project_Node_Id)
is
Field_Id : Project_Node_Id := Empty_Node;
@@ -397,24 +401,31 @@ package body Prj.Strt is
Scan (In_Tree);
- Expect (Tok_String_Literal, "literal string");
+ -- Get the string expression for the default
- -- Get the default
+ declare
+ Loc : constant Source_Ptr := Token_Ptr;
- if Token = Tok_String_Literal then
- Field_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String,
- In_Tree => In_Tree,
- And_Expr_Kind => Single);
- Set_String_Value_Of (Field_Id, In_Tree, To => Token_Name);
- Set_External_Default_Of
- (External_Value, In_Tree, To => Field_Id);
- Scan (In_Tree);
- Expect (Tok_Right_Paren, "`)`");
- end if;
+ begin
+ Parse_Expression
+ (In_Tree => In_Tree,
+ Expression => Field_Id,
+ Current_Project => Current_Project,
+ Current_Package => Current_Package,
+ Optional_Index => False);
+
+ if Expression_Kind_Of (Field_Id, In_Tree) = List then
+ Error_Msg ("expression must be a single string", Loc);
+ else
+ Set_External_Default_Of
+ (External_Value, In_Tree, To => Field_Id);
+ end if;
+ end;
+
+ Expect (Tok_Right_Paren, "`)`");
-- Scan past the right parenthesis
+
if Token = Tok_Right_Paren then
Scan (In_Tree);
end if;
@@ -1417,7 +1428,10 @@ package body Prj.Strt is
end if;
External_Reference
- (In_Tree => In_Tree, External_Value => Reference);
+ (In_Tree => In_Tree,
+ Current_Project => Current_Project,
+ Current_Package => Current_Package,
+ External_Value => Reference);
Set_Current_Term (Term, In_Tree, To => Reference);
when others =>
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 37237d36b27..83dab6944b9 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -90,6 +90,7 @@ package body Prj is
Supp_Languages => No_Supp_Language_Index,
First_Referred_By => No_Project,
Name => No_Name,
+ Display_Name => No_Name,
Path_Name => No_Name,
Display_Path_Name => No_Name,
Virtual => False,
@@ -227,9 +228,10 @@ package body Prj is
-------------------
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
- Value : Project_Data := Project_Empty;
+ Value : Project_Data;
begin
Prj.Initialize (Tree => No_Project_Tree);
+ Value := Project_Empty;
Value.Naming := Tree.Private_Part.Default_Naming;
return Value;
end Empty_Project;
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index aa58c2f5eb2..cfe0da08f75 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -422,7 +422,7 @@ package Prj is
Attributes => No_Variable,
Arrays => No_Array,
Packages => No_Package);
- -- Default value of Declarations: indicates that there is no declarations.
+ -- Default value of Declarations: indicates that there is no declarations
type Package_Element is record
Name : Name_Id := No_Name;
@@ -430,7 +430,7 @@ package Prj is
Parent : Package_Id := No_Package;
Next : Package_Id := No_Package;
end record;
- -- A package. Includes declarations that may include other packages.
+ -- A package. Includes declarations that may include other packages
package Package_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Package_Element,
@@ -438,7 +438,7 @@ package Prj is
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100);
- -- The table that contains all packages.
+ -- The table that contains all packages
function Image (Casing : Casing_Type) return String;
-- Similar to 'Image (but avoid use of this attribute in compiler)
@@ -452,14 +452,14 @@ package Prj is
type Naming_Data is record
Dot_Replacement : Name_Id := No_Name;
- -- The string to replace '.' in the source file name (for Ada).
+ -- The string to replace '.' in the source file name (for Ada)
Dot_Repl_Loc : Source_Ptr := No_Location;
- -- The position in the project file source where
- -- Dot_Replacement is defined.
+ -- The position in the project file source where Dot_Replacement is
+ -- defined.
Casing : Casing_Type := All_Lower_Case;
- -- The casing of the source file name (for Ada).
+ -- The casing of the source file name (for Ada)
Spec_Suffix : Array_Element_Id := No_Array_Element;
-- The string to append to the unit name for the
@@ -490,17 +490,17 @@ package Prj is
-- Ada_Body_Suffix is defined.
Separate_Suffix : Name_Id := No_Name;
- -- String to append to unit name for source file name of an Ada subunit.
+ -- String to append to unit name for source file name of an Ada subunit
Sep_Suffix_Loc : Source_Ptr := No_Location;
- -- Position in the project file source where Separate_Suffix is defined.
+ -- Position in the project file source where Separate_Suffix is defined
Specs : Array_Element_Id := No_Array_Element;
- -- An associative array mapping individual specs to source file names.
+ -- An associative array mapping individual specs to source file names
-- This is specific to Ada.
Bodies : Array_Element_Id := No_Array_Element;
- -- An associative array mapping individual bodies to source file names.
+ -- An associative array mapping individual bodies to source file names
-- This is specific to Ada.
Specification_Exceptions : Array_Element_Id := No_Array_Element;
@@ -554,15 +554,18 @@ package Prj is
-- Indicate the different languages of the source of this project
First_Referred_By : Project_Id := No_Project;
- -- The project, if any, that was the first to be known
- -- as importing or extending this project.
- -- Set by Prj.Proc.Process.
+ -- The project, if any, that was the first to be known as importing or
+ -- extending this project. Set by Prj.Proc.Process.
Name : Name_Id := No_Name;
- -- The name of the project. Set by Prj.Proc.Process.
+ -- The name of the project. Set by Prj.Proc.Process
+
+ Display_Name : Name_Id := No_Name;
+ -- The name of the project with the spelling of its declaration.
+ -- Set by Prj.Proc.Process.
Path_Name : Name_Id := No_Name;
- -- The path name of the project file. Set by Prj.Proc.Process.
+ -- The path name of the project file. Set by Prj.Proc.Process
Display_Path_Name : Name_Id := No_Name;
-- The path name used for display purposes. May be different from
@@ -576,36 +579,36 @@ package Prj is
-- project. Set by Prj.Proc.Process.
Mains : String_List_Id := Nil_String;
- -- List of mains specified by attribute Main. Set by Prj.Nmsc.Check.
+ -- List of mains specified by attribute Main. Set by Prj.Nmsc.Check
Directory : Name_Id := No_Name;
- -- Directory where the project file resides. Set by Prj.Proc.Process.
+ -- Directory where the project file resides. Set by Prj.Proc.Process
Display_Directory : Name_Id := No_Name;
Dir_Path : String_Access;
- -- Same as Directory, but as an access to String.
- -- Set by Make.Compile_Sources.Collect_Arguments_And_Compile.
+ -- Same as Directory, but as an access to String. Set by
+ -- Make.Compile_Sources.Collect_Arguments_And_Compile.
Library : Boolean := False;
- -- True if this is a library project.
- -- Set by Prj.Nmsc.Language_Independent_Check.
+ -- True if this is a library project. Set by
+ -- Prj.Nmsc.Language_Independent_Check.
Library_Dir : Name_Id := No_Name;
- -- If a library project, directory where resides the library
- -- Set by Prj.Nmsc.Language_Independent_Check.
+ -- If a library project, directory where resides the library Set by
+ -- Prj.Nmsc.Language_Independent_Check.
Display_Library_Dir : Name_Id := No_Name;
- -- The name of the library directory, for display purposes.
- -- May be different from Library_Dir for platforms where the file names
- -- are case-insensitive.
+ -- The name of the library directory, for display purposes. May be
+ -- different from Library_Dir for platforms where the file names are
+ -- case-insensitive.
Library_Src_Dir : Name_Id := No_Name;
-- If a library project, directory where the sources and the ALI files
-- of the library are copied. By default, if attribute Library_Src_Dir
-- is not specified, sources are not copied anywhere and ALI files are
- -- copied in the Library Directory.
- -- Set by Prj.Nmsc.Language_Independent_Check.
+ -- copied in the Library Directory. Set by
+ -- Prj.Nmsc.Language_Independent_Check.
Display_Library_Src_Dir : Name_Id := No_Name;
-- The name of the library source directory, for display purposes.
@@ -621,16 +624,16 @@ package Prj is
-- Set by Prj.Nmsc.Language_Independent_Check.
Lib_Internal_Name : Name_Id := No_Name;
- -- If a library project, internal name store inside the library
- -- Set by Prj.Nmsc.Language_Independent_Check.
+ -- If a library project, internal name store inside the library Set by
+ -- Prj.Nmsc.Language_Independent_Check.
Standalone_Library : Boolean := False;
- -- Indicate that this is a Standalone Library Project File.
- -- Set by Prj.Nmsc.Check.
+ -- Indicate that this is a Standalone Library Project File. Set by
+ -- Prj.Nmsc.Check.
Lib_Interface_ALIs : String_List_Id := Nil_String;
- -- For Standalone Library Project Files, indicate the list
- -- of Interface ALI files. Set by Prj.Nmsc.Check.
+ -- For Standalone Library Project Files, indicate the list of Interface
+ -- ALI files. Set by Prj.Nmsc.Check.
Lib_Auto_Init : Boolean := False;
-- For non static Standalone Library Project Files, indicate if
@@ -691,17 +694,17 @@ package Prj is
-- Object_Directory. Set by Prj.Nmsc.Language_Independent_Check.
Display_Exec_Dir : Name_Id := No_Name;
- -- The name of the exec directory, for display purposes.
- -- May be different from Exec_Directory for platforms where the file
- -- names are case-insensitive.
+ -- The name of the exec directory, for display purposes. May be
+ -- different from Exec_Directory for platforms where the file names are
+ -- case-insensitive.
Extends : Project_Id := No_Project;
- -- The reference of the project file, if any, that this
- -- project file extends. Set by Prj.Proc.Process.
+ -- The reference of the project file, if any, that this project file
+ -- extends. Set by Prj.Proc.Process.
Extended_By : Project_Id := No_Project;
- -- The reference of the project file, if any, that
- -- extends this project file. Set by Prj.Proc.Process.
+ -- The reference of the project file, if any, that extends this project
+ -- file. Set by Prj.Proc.Process.
Naming : Naming_Data := Standard_Naming_Data;
-- The naming scheme of this project file.
@@ -721,17 +724,17 @@ package Prj is
-- project file. Set by Prj.Proc.Process.
Imported_Projects : Project_List := Empty_Project_List;
- -- The list of all directly imported projects, if any.
- -- Set by Prj.Proc.Process.
+ -- The list of all directly imported projects, if any. Set by
+ -- Prj.Proc.Process.
Ada_Include_Path : String_Access := null;
- -- The cached value of ADA_INCLUDE_PATH for this project file.
- -- Do not use this field directly outside of the compiler, use
+ -- The cached value of ADA_INCLUDE_PATH for this project file. Do not
+ -- use this field directly outside of the compiler, use
-- Prj.Env.Ada_Include_Path instead. Set by Prj.Env.Ada_Include_Path.
Ada_Objects_Path : String_Access := null;
- -- The cached value of ADA_OBJECTS_PATH for this project file.
- -- Do not use this field directly outside of the compiler, use
+ -- The cached value of ADA_OBJECTS_PATH for this project file. Do not
+ -- use this field directly outside of the compiler, use
-- Prj.Env.Ada_Objects_Path instead. Set by Prj.Env.Ada_Objects_Path
Include_Path_File : Name_Id := No_Name;
@@ -791,7 +794,7 @@ package Prj is
-- The project tree Tree must have been Initialized and/or Reset.
Project_Error : exception;
- -- Raised by some subprograms in Prj.Attr.
+ -- Raised by some subprograms in Prj.Attr
package Project_Table is new GNAT.Dynamic_Tables (
Table_Component_Type => Project_Data,
@@ -813,7 +816,7 @@ package Prj is
Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False;
end record;
- -- File and Path name of a spec or body.
+ -- File and Path name of a spec or body
type File_Names_Data is array (Spec_Or_Body) of File_Name_Data;