Skip to content

R
riscv-gcc-1
Commit c8b0c260 by Vincent Celier Committed by Arnaud Charlet
Options

prj.ads, prj.adb: (Project_Data): Add new component Display_Name 

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.

From-SVN: r97180
parent 4f62e49c
Showing with 143 additions and 79 deletions
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
......
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 :=
......
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 =>
......
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;
......
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