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

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;

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;