diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 54d2812d7a6c..1b100843b428 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 ed3a8b91c169..7ccd5750cf39 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 ae7941c203b1..91539e940830 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 37237d36b27a..83dab6944b99 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 aa58c2f5eb24..cfe0da08f750 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;