Skip to content

R
riscv-gcc-1
Commit f6cf5b85 by Arnaud Charlet
Options

[multiple changes] 

2009-07-09  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Find_Sources): Avoid error messages from gprbuild from
	multi-unit files.

2009-07-09  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb: Minor reformatting

	* exp_ch3.adb: Minor comment fix.

	* sinfo.ads: Minor comment fix

2009-07-09  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Conditional_Expression): Set Related_Expression.

From-SVN: r149411
parent 7aedb36a
Showing with 170 additions and 140 deletions
gcc/ada/ChangeLog
2009-07-09 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Find_Sources): Avoid error messages from gprbuild from
multi-unit files.
2009-07-09 Thomas Quinot <quinot@adacore.com>
* freeze.adb: Minor reformatting
* exp_ch3.adb: Minor comment fix.
* sinfo.ads: Minor comment fix
2009-07-09 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_N_Conditional_Expression): Set Related_Expression.
2009-07-09 Ed Schonberg <schonberg@adacore.com> 2009-07-09 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_Expression): If the expression is the name of a * freeze.adb (Freeze_Expression): If the expression is the name of a
......
gcc/ada/exp_ch3.adb
...@@ -6014,7 +6014,7 @@ package body Exp_Ch3 is ...@@ -6014,7 +6014,7 @@ package body Exp_Ch3 is
Append_Freeze_Actions (Def_Id, Wrapper_Body_List); Append_Freeze_Actions (Def_Id, Wrapper_Body_List);
end if; end if;
-- Create extra actuals for the primitive operations of the type. -- Create extra formals for the primitive operations of the type.
-- This must be done before analyzing the body of the initialization -- This must be done before analyzing the body of the initialization
-- procedure, because a self-referential type might call one of these -- procedure, because a self-referential type might call one of these
-- primitives in the body of the init_proc itself. -- primitives in the body of the init_proc itself.
......
gcc/ada/exp_ch4.adb
...@@ -4046,8 +4046,8 @@ package body Exp_Ch4 is ...@@ -4046,8 +4046,8 @@ package body Exp_Ch4 is
Name => New_Occurrence_Of (Cnn, Sloc (Elsex)), Name => New_Occurrence_Of (Cnn, Sloc (Elsex)),
Expression => Relocate_Node (Elsex)))); Expression => Relocate_Node (Elsex))));
-- Move the SLOC of the parent If statement to the newly created -- Move the SLOC of the parent If statement to the newly created one
-- one and change it to the SLOC of the expression which, after -- and change it to the SLOC of the expression which, after
-- expansion, will correspond to what is being evaluated. -- expansion, will correspond to what is being evaluated.
if Present (Parent (N)) if Present (Parent (N))
...@@ -4079,6 +4079,10 @@ package body Exp_Ch4 is ...@@ -4079,6 +4079,10 @@ package body Exp_Ch4 is
Insert_Action (N, New_If); Insert_Action (N, New_If);
Analyze_And_Resolve (N, Typ); Analyze_And_Resolve (N, Typ);
-- Link temporary to original expression, for Codepeer
Set_Related_Expression (Cnn, Original_Node (N));
end if; end if;
end Expand_N_Conditional_Expression; end Expand_N_Conditional_Expression;
......
gcc/ada/freeze.adb
...@@ -4014,7 +4014,7 @@ package body Freeze is ...@@ -4014,7 +4014,7 @@ package body Freeze is
-- For a function, we freeze the entity when the subprogram declaration -- For a function, we freeze the entity when the subprogram declaration
-- is frozen, but a function call may appear in an initialization proc. -- is frozen, but a function call may appear in an initialization proc.
-- before the declaration is frozen. We need to generate the extra -- before the declaration is frozen. We need to generate the extra
-- formals, if any, to ensure that the expansion of the call includes -- formals, if any, to ensure that the expansion of the call includes
-- the proper actuals. -- the proper actuals.
...@@ -4067,12 +4067,12 @@ package body Freeze is ...@@ -4067,12 +4067,12 @@ package body Freeze is
return; return;
end if; end if;
-- Loop for looking at the right place to insert the freeze nodes -- Loop for looking at the right place to insert the freeze nodes,
-- exiting from the loop when it is appropriate to insert the freeze -- exiting from the loop when it is appropriate to insert the freeze
-- node before the current node P. -- node before the current node P.
-- Also checks some special exceptions to the freezing rules. These -- Also checks som special exceptions to the freezing rules. These cases
-- cases result in a direct return, bypassing the freeze action. -- result in a direct return, bypassing the freeze action.
P := N; P := N;
loop loop
......
gcc/ada/prj-nmsc.adb
...@@ -130,9 +130,8 @@ package body Prj.Nmsc is ...@@ -130,9 +130,8 @@ package body Prj.Nmsc is
Key => Name_Id, Key => Name_Id,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- Hash table to store recursive source directories, to avoid looking -- Hash table stores recursive source directories, to avoid looking several
-- several times, and to avoid cycles that may be introduced by symbolic -- times, and to avoid cycles that may be introduced by symbolic links.
-- links.
type Ada_Naming_Exception_Id is new Nat; type Ada_Naming_Exception_Id is new Nat;
No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0; No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0;
...@@ -428,14 +427,11 @@ package body Prj.Nmsc is ...@@ -428,14 +427,11 @@ package body Prj.Nmsc is
Unit : out Name_Id; Unit : out Name_Id;
Lang_Kind : out Language_Kind; Lang_Kind : out Language_Kind;
Kind : out Source_Kind); Kind : out Source_Kind);
-- Check if the file name File_Name conforms to one of the naming -- Check if the file name File_Name conforms to one of the naming schemes
-- schemes of the project. -- of the project. If the file does not match one of the naming schemes,
-- -- set Language to No_Language_Index. Filename is the name of the file
-- If the file does not match one of the naming schemes, set Language -- being investigated. It has been normalized (case-folded). File_Name is
-- to No_Language_Index. -- the same value.
--
-- Filename is the name of the file being investigated. It has been
-- normalized (case-folded). File_Name is the same value.
procedure Free_Ada_Naming_Exceptions; procedure Free_Ada_Naming_Exceptions;
-- Free the internal hash tables used for checking naming exceptions -- Free the internal hash tables used for checking naming exceptions
...@@ -445,10 +441,8 @@ package body Prj.Nmsc is ...@@ -445,10 +441,8 @@ package body Prj.Nmsc is
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Current_Dir : String); Current_Dir : String);
-- Get the object directory, the exec directory and the source directories -- Get the object directory, the exec directory and the source directories
-- of a project. -- of a project. Current_Dir should represent the current directory, and is
-- -- passed for efficiency to avoid system calls to recompute it.
-- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it.
procedure Get_Mains procedure Get_Mains
(Project : Project_Id; (Project : Project_Id;
...@@ -469,13 +463,12 @@ package body Prj.Nmsc is ...@@ -469,13 +463,12 @@ package body Prj.Nmsc is
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Proc_Data : in out Processing_Data; Proc_Data : in out Processing_Data;
Allow_Duplicate_Basenames : Boolean); Allow_Duplicate_Basenames : Boolean);
-- Process the Source_Files and Source_List_File attributes, and store -- Process the Source_Files and Source_List_File attributes, and store the
-- the list of source files into the Source_Names htable. -- list of source files into the Source_Names htable. When these attributes
-- When these attributes are not defined, find all files matching the -- are not defined, find all files matching the naming schemes in the
-- naming schemes in the source directories. -- source directories. If Allow_Duplicate_Basenames, then files with the
-- If Allow_Duplicate_Basenames, then files with the same base names are -- same base names are authorized within a project for source-based
-- authorized within a project for source-based languages (never for unit -- languages (never for unit based languages)
-- based languages)
procedure Compute_Unit_Name procedure Compute_Unit_Name
(File_Name : File_Name_Type; (File_Name : File_Name_Type;
...@@ -516,18 +509,15 @@ package body Prj.Nmsc is ...@@ -516,18 +509,15 @@ package body Prj.Nmsc is
Location : Source_Ptr := No_Location; Location : Source_Ptr := No_Location;
Must_Exist : Boolean := True; Must_Exist : Boolean := True;
Externally_Built : Boolean := False); Externally_Built : Boolean := False);
-- Locate a directory. Name is the directory name. -- Locate a directory. Name is the directory name. Relative paths are
-- Relative paths are resolved relative to the project's directory. -- resolved relative to the project's directory. If the directory does not
-- If the directory does not exist and Setup_Projects -- exist and Setup_Projects is True and Create is a non null string, an
-- is True and Create is a non null string, an attempt is made to create -- attempt is made to create the directory. If the directory does not
-- the directory. -- exist, it is either created if Setup_Projects is False (and then
-- If the directory does not exist, it is either created if Setup_Projects -- returned), or simply returned without checking for its existence (if
-- is False (and then returned), or simply returned without checking for -- Must_Exist is False) or No_Path_Information is returned. In all cases,
-- its existence (if Must_Exist is False) or No_Path_Information is -- Dir_Exists indicates whether the directory now exists. Create is also
-- returned. In all cases, Dir_Exists indicates whether the directory now -- used for debugging traces to show which path we are
-- exists.
--
-- Create is also used for debugging traces to show which path we are
-- computing -- computing
procedure Look_For_Sources procedure Look_For_Sources
...@@ -643,6 +633,7 @@ package body Prj.Nmsc is ...@@ -643,6 +633,7 @@ package body Prj.Nmsc is
Suffix : File_Name_Type) return Boolean Suffix : File_Name_Type) return Boolean
is is
Min_Prefix_Length : Natural := 0; Min_Prefix_Length : Natural := 0;
begin begin
if Suffix = No_File or else Suffix = Empty_File then if Suffix = No_File or else Suffix = Empty_File then
return False; return False;
...@@ -650,8 +641,8 @@ package body Prj.Nmsc is ...@@ -650,8 +641,8 @@ package body Prj.Nmsc is
declare declare
Suf : constant String := Get_Name_String (Suffix); Suf : constant String := Get_Name_String (Suffix);
begin
begin
-- The file name must end with the suffix (which is not an extension) -- The file name must end with the suffix (which is not an extension)
-- For instance a suffix "configure.in" must match a file with the -- For instance a suffix "configure.in" must match a file with the
-- same name. To avoid dummy cases, though, a suffix starting with -- same name. To avoid dummy cases, though, a suffix starting with
...@@ -701,8 +692,8 @@ package body Prj.Nmsc is ...@@ -701,8 +692,8 @@ package body Prj.Nmsc is
Index : Int := 0; Index : Int := 0;
Source_To_Replace : Source_Id := No_Source) Source_To_Replace : Source_Id := No_Source)
is is
Config : constant Language_Config := Lang_Id.Config; Config : constant Language_Config := Lang_Id.Config;
UData : Unit_Index; UData : Unit_Index;
begin begin
Id := new Source_Data; Id := new Source_Data;
...@@ -713,11 +704,14 @@ package body Prj.Nmsc is ...@@ -713,11 +704,14 @@ package body Prj.Nmsc is
if Lang_Id.Config.Kind = Unit_Based then if Lang_Id.Config.Kind = Unit_Based then
Write_Str (" Unit: "); Write_Str (" Unit: ");
-- ??? in gprclean, it seems we sometimes pass an empty Unit name -- ??? in gprclean, it seems we sometimes pass an empty Unit name
-- (see test extended_projects) -- (see test extended_projects).
if Unit /= No_Name then if Unit /= No_Name then
Write_Str (Get_Name_String (Unit)); Write_Str (Get_Name_String (Unit));
end if; end if;
Write_Str (" Kind: "); Write_Str (" Kind: ");
Write_Str (Source_Kind'Image (Kind)); Write_Str (Source_Kind'Image (Kind));
end if; end if;
...@@ -743,7 +737,7 @@ package body Prj.Nmsc is ...@@ -743,7 +737,7 @@ package body Prj.Nmsc is
UData := Units_Htable.Get (In_Tree.Units_HT, Unit); UData := Units_Htable.Get (In_Tree.Units_HT, Unit);
if UData = No_Unit_Index then if UData = No_Unit_Index then
UData := new Unit_Data; UData := new Unit_Data;
UData.Name := Unit; UData.Name := Unit;
Units_Htable.Set (In_Tree.Units_HT, Unit, UData); Units_Htable.Set (In_Tree.Units_HT, Unit, UData);
end if; end if;
...@@ -831,8 +825,8 @@ package body Prj.Nmsc is ...@@ -831,8 +825,8 @@ package body Prj.Nmsc is
Compiler_Driver_Mandatory : Boolean; Compiler_Driver_Mandatory : Boolean;
Allow_Duplicate_Basenames : Boolean) Allow_Duplicate_Basenames : Boolean)
is is
Specs : Array_Element_Id; Specs : Array_Element_Id;
Bodies : Array_Element_Id; Bodies : Array_Element_Id;
Extending : Boolean := False; Extending : Boolean := False;
begin begin
...@@ -883,8 +877,8 @@ package body Prj.Nmsc is ...@@ -883,8 +877,8 @@ package body Prj.Nmsc is
else else
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"at least one of Source_Files, Source_Dirs or Languages " & "at least one of Source_Files, Source_Dirs or Languages "
"must be declared empty for an abstract project", & "must be declared empty for an abstract project",
Project.Location); Project.Location);
end if; end if;
end; end;
...@@ -940,19 +934,18 @@ package body Prj.Nmsc is ...@@ -940,19 +934,18 @@ package body Prj.Nmsc is
(not Extending) (not Extending)
then then
declare declare
Language : Language_Ptr; Language : Language_Ptr;
Source : Source_Id; Source : Source_Id;
Alt_Lang : Language_List; Alt_Lang : Language_List;
Continuation : Boolean := False; Continuation : Boolean := False;
Iter : Source_Iterator; Iter : Source_Iterator;
begin begin
Language := Project.Languages; Language := Project.Languages;
while Language /= No_Language_Index loop while Language /= No_Language_Index loop
-- If there are no sources for this language, check whether -- If there are no sources for this language, check if there
-- there are sources for which this is an alternate -- are sources for which this is an alternate language.
-- language.
if Language.First_Source = No_Source then if Language.First_Source = No_Source then
Iter := For_Each_Source (In_Tree => In_Tree, Iter := For_Each_Source (In_Tree => In_Tree,
...@@ -1141,6 +1134,7 @@ package body Prj.Nmsc is ...@@ -1141,6 +1134,7 @@ package body Prj.Nmsc is
elsif The_Name (Index) = '.' then elsif The_Name (Index) = '.' then
-- First, check if the name before the dot is not a reserved word -- First, check if the name before the dot is not a reserved word
if Is_Reserved (The_Name (First .. Index - 1)) then if Is_Reserved (The_Name (First .. Index - 1)) then
return; return;
end if; end if;
...@@ -1716,6 +1710,7 @@ package body Prj.Nmsc is ...@@ -1716,6 +1710,7 @@ package body Prj.Nmsc is
Current_Array : Array_Data; Current_Array : Array_Data;
Element_Id : Array_Element_Id; Element_Id : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
begin begin
-- Process the associative array attribute of package Naming -- Process the associative array attribute of package Naming
...@@ -2368,6 +2363,8 @@ package body Prj.Nmsc is ...@@ -2368,6 +2363,8 @@ package body Prj.Nmsc is
end loop; end loop;
end Process_Project_Level_Array_Attributes; end Process_Project_Level_Array_Attributes;
-- Start of processing for Check_Configuration
begin begin
Process_Project_Level_Simple_Attributes; Process_Project_Level_Simple_Attributes;
Process_Project_Level_Array_Attributes; Process_Project_Level_Array_Attributes;
...@@ -2410,6 +2407,7 @@ package body Prj.Nmsc is ...@@ -2410,6 +2407,7 @@ package body Prj.Nmsc is
Lang_Index := Project.Languages; Lang_Index := Project.Languages;
while Lang_Index /= No_Language_Index loop while Lang_Index /= No_Language_Index loop
-- For all languages, Compiler_Driver needs to be specified. This is -- For all languages, Compiler_Driver needs to be specified. This is
-- only needed if we do intend to compile (not in GPS for instance). -- only needed if we do intend to compile (not in GPS for instance).
...@@ -2559,7 +2557,6 @@ package body Prj.Nmsc is ...@@ -2559,7 +2557,6 @@ package body Prj.Nmsc is
Project_2 := Project; Project_2 := Project;
while Project_2 /= No_Project loop while Project_2 /= No_Project loop
Iter := For_Each_Source (In_Tree, Project_2); Iter := For_Each_Source (In_Tree, Project_2);
loop loop
Source := Prj.Element (Iter); Source := Prj.Element (Iter);
exit when Source = No_Source; exit when Source = No_Source;
...@@ -2835,6 +2832,7 @@ package body Prj.Nmsc is ...@@ -2835,6 +2832,7 @@ package body Prj.Nmsc is
declare declare
Casing_Image : constant String := Casing_Image : constant String :=
Get_Name_String (Casing_String.Value); Get_Name_String (Casing_String.Value);
begin begin
if Casing_Image'Length = 0 then if Casing_Image'Length = 0 then
Error_Msg Error_Msg
...@@ -3130,7 +3128,7 @@ package body Prj.Nmsc is ...@@ -3130,7 +3128,7 @@ package body Prj.Nmsc is
procedure Check_Naming_Ada_Only is procedure Check_Naming_Ada_Only is
Ada : constant Language_Ptr := Ada : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada"); Get_Language_From_Name (Project, "ada");
Casing_Defined : Boolean; Casing_Defined : Boolean;
Sep_Suffix_Loc : Source_Ptr; Sep_Suffix_Loc : Source_Ptr;
...@@ -3250,7 +3248,7 @@ package body Prj.Nmsc is ...@@ -3250,7 +3248,7 @@ package body Prj.Nmsc is
-- For all unit based languages, if any, set the specified value -- For all unit based languages, if any, set the specified value
-- of Dot_Replacement, Casing and/or Separate_Suffix. Do not -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
-- systematically overwrite, since the defaults come from the -- systematically overwrite, since the defaults come from the
-- configuration file -- configuration file.
if Dot_Replacement /= No_File if Dot_Replacement /= No_File
or else Casing_Defined or else Casing_Defined
...@@ -3407,8 +3405,7 @@ package body Prj.Nmsc is ...@@ -3407,8 +3405,7 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
-- If the language was not found in project or the projects it -- If language was not found in project or the projects it extends
-- extends
if Lang = null then if Lang = null then
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -3714,6 +3711,7 @@ package body Prj.Nmsc is ...@@ -3714,6 +3711,7 @@ package body Prj.Nmsc is
end if; end if;
if not Dir_Exists then if not Dir_Exists then
-- Get the absolute name of the library directory that -- Get the absolute name of the library directory that
-- does not exist, to report an error. -- does not exist, to report an error.
...@@ -3897,6 +3895,7 @@ package body Prj.Nmsc is ...@@ -3897,6 +3895,7 @@ package body Prj.Nmsc is
Externally_Built => Project.Externally_Built); Externally_Built => Project.Externally_Built);
if not Dir_Exists then if not Dir_Exists then
-- Get the absolute name of the library ALI directory that -- Get the absolute name of the library ALI directory that
-- does not exist, to report an error. -- does not exist, to report an error.
...@@ -3998,8 +3997,7 @@ package body Prj.Nmsc is ...@@ -3998,8 +3997,7 @@ package body Prj.Nmsc is
elsif Current_Verbosity = High then elsif Current_Verbosity = High then
-- Display the Library ALI directory in high -- Display Library ALI directory in high verbosity
-- verbosity.
Write_Attr Write_Attr
("Library ALI dir", ("Library ALI dir",
...@@ -4197,9 +4195,15 @@ package body Prj.Nmsc is ...@@ -4197,9 +4195,15 @@ package body Prj.Nmsc is
-- Add a new language to the list of languages for the project. -- Add a new language to the list of languages for the project.
-- Nothing is done if the language has already been defined -- Nothing is done if the language has already been defined
------------------
-- Add_Language --
------------------
procedure Add_Language (Name, Display_Name : Name_Id) is procedure Add_Language (Name, Display_Name : Name_Id) is
Lang : Language_Ptr := Project.Languages; Lang : Language_Ptr;
begin begin
Lang := Project.Languages;
while Lang /= No_Language_Index loop while Lang /= No_Language_Index loop
if Name = Lang.Name then if Name = Lang.Name then
return; return;
...@@ -4219,10 +4223,11 @@ package body Prj.Nmsc is ...@@ -4219,10 +4223,11 @@ package body Prj.Nmsc is
Lang.Config.Dependency_Kind := ALI_File; Lang.Config.Dependency_Kind := ALI_File;
if Get_Mode = Ada_Only then if Get_Mode = Ada_Only then
-- Create a default config for Ada (since there is no -- Create a default config for Ada (since there is no
-- configuration file to create it for us) -- configuration file to create it for us).
-- ??? We should do as GPS does and create a dummy config
-- file -- ??? We should do as GPS does and create a dummy config file
Lang.Config.Naming_Data := Lang.Config.Naming_Data :=
(Dot_Replacement => File_Name_Type (Dot_Replacement => File_Name_Type
...@@ -4615,6 +4620,7 @@ package body Prj.Nmsc is ...@@ -4615,6 +4620,7 @@ package body Prj.Nmsc is
if Source /= No_Source then if Source /= No_Source then
if Source.Kind = Sep then if Source.Kind = Sep then
Source := No_Source; Source := No_Source;
elsif Source.Kind = Spec elsif Source.Kind = Spec
and then Other_Part (Source) /= No_Source and then Other_Part (Source) /= No_Source
then then
...@@ -4724,8 +4730,8 @@ package body Prj.Nmsc is ...@@ -4724,8 +4730,8 @@ package body Prj.Nmsc is
if Lib_Src_Dir.Value /= Empty_String then if Lib_Src_Dir.Value /= Empty_String then
declare declare
Dir_Id : constant File_Name_Type := Dir_Id : constant File_Name_Type :=
File_Name_Type (Lib_Src_Dir.Value); File_Name_Type (Lib_Src_Dir.Value);
Dir_Exists : Boolean; Dir_Exists : Boolean;
begin begin
...@@ -4743,6 +4749,7 @@ package body Prj.Nmsc is ...@@ -4743,6 +4749,7 @@ package body Prj.Nmsc is
-- If directory does not exist, report an error -- If directory does not exist, report an error
if not Dir_Exists then if not Dir_Exists then
-- Get the absolute name of the library directory that does -- Get the absolute name of the library directory that does
-- not exist, to report an error. -- not exist, to report an error.
...@@ -5055,7 +5062,7 @@ package body Prj.Nmsc is ...@@ -5055,7 +5062,7 @@ package body Prj.Nmsc is
begin begin
if Dir'Length > 1 if Dir'Length > 1
and then (Dir (Dir'Last - 1) = Directory_Separator and then (Dir (Dir'Last - 1) = Directory_Separator
or else Dir (Dir'Last - 1) = '/') or else Dir (Dir'Last - 1) = '/')
then then
return Dir'Last - 1; return Dir'Last - 1;
else else
...@@ -5361,8 +5368,7 @@ package body Prj.Nmsc is ...@@ -5361,8 +5368,7 @@ package body Prj.Nmsc is
Write_Line (The_Path (The_Path'First .. The_Path_Last)); Write_Line (The_Path (The_Path'First .. The_Path_Last));
end if; end if;
String_Element_Table.Increment_Last String_Element_Table.Increment_Last (In_Tree.String_Elements);
(In_Tree.String_Elements);
Element := Element :=
(Value => Canonical_Path, (Value => Canonical_Path,
Display_Value => Non_Canonical_Path, Display_Value => Non_Canonical_Path,
...@@ -5374,8 +5380,8 @@ package body Prj.Nmsc is ...@@ -5374,8 +5380,8 @@ package body Prj.Nmsc is
-- Case of first source directory -- Case of first source directory
if Last_Source_Dir = Nil_String then if Last_Source_Dir = Nil_String then
Project.Source_Dirs := String_Element_Table.Last Project.Source_Dirs :=
(In_Tree.String_Elements); String_Element_Table.Last (In_Tree.String_Elements);
-- Here we already have source directories -- Here we already have source directories
...@@ -5384,16 +5390,14 @@ package body Prj.Nmsc is ...@@ -5384,16 +5390,14 @@ package body Prj.Nmsc is
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(Last_Source_Dir).Next := (Last_Source_Dir).Next :=
String_Element_Table.Last String_Element_Table.Last (In_Tree.String_Elements);
(In_Tree.String_Elements);
end if; end if;
-- And register this source directory as the new last -- And register this source directory as the new last
Last_Source_Dir := String_Element_Table.Last Last_Source_Dir :=
(In_Tree.String_Elements); String_Element_Table.Last (In_Tree.String_Elements);
In_Tree.String_Elements.Table (Last_Source_Dir) := In_Tree.String_Elements.Table (Last_Source_Dir) := Element;
Element;
elsif Removed and Found then elsif Removed and Found then
if Prev = Nil_String then if Prev = Nil_String then
...@@ -5544,10 +5548,10 @@ package body Prj.Nmsc is ...@@ -5544,10 +5548,10 @@ package body Prj.Nmsc is
else else
declare declare
Path_Name : Path_Information; Path_Name : Path_Information;
List : String_List_Id; List : String_List_Id;
Prev : String_List_Id; Prev : String_List_Id;
Dir_Exists : Boolean; Dir_Exists : Boolean;
begin begin
Locate_Directory Locate_Directory
...@@ -5714,8 +5718,7 @@ package body Prj.Nmsc is ...@@ -5714,8 +5718,7 @@ package body Prj.Nmsc is
-- However, even when it doesn't exist, we set it to a default -- However, even when it doesn't exist, we set it to a default
-- value. This is for the benefit of tools that recover from -- value. This is for the benefit of tools that recover from
-- errors; for example, these tools could create the non existent -- errors; for example, these tools could create the non existent
-- directory. -- directory. We always return an absolute directory name though.
-- We always return an absolute directory name though
Locate_Directory Locate_Directory
(Project, (Project,
...@@ -5825,8 +5828,8 @@ package body Prj.Nmsc is ...@@ -5825,8 +5828,8 @@ package body Prj.Nmsc is
pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list"); pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
if (not Source_Files.Default) and then if (not Source_Files.Default)
Source_Files.Values = Nil_String and then Source_Files.Values = Nil_String
then then
Project.Source_Dirs := Nil_String; Project.Source_Dirs := Nil_String;
...@@ -5841,7 +5844,7 @@ package body Prj.Nmsc is ...@@ -5841,7 +5844,7 @@ package body Prj.Nmsc is
elsif Source_Dirs.Default then elsif Source_Dirs.Default then
-- No Source_Dirs specified: the single source directory is the one -- No Source_Dirs specified: the single source directory is the one
-- containing the project file -- containing the project file.
String_Element_Table.Append (In_Tree.String_Elements, String_Element_Table.Append (In_Tree.String_Elements,
(Value => Name_Id (Project.Directory.Name), (Value => Name_Id (Project.Directory.Name),
...@@ -5850,8 +5853,8 @@ package body Prj.Nmsc is ...@@ -5850,8 +5853,8 @@ package body Prj.Nmsc is
Flag => False, Flag => False,
Next => Nil_String, Next => Nil_String,
Index => 0)); Index => 0));
Project.Source_Dirs := String_Element_Table.Last Project.Source_Dirs :=
(In_Tree.String_Elements); String_Element_Table.Last (In_Tree.String_Elements);
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Attr Write_Attr
...@@ -6077,8 +6080,8 @@ package body Prj.Nmsc is ...@@ -6077,8 +6080,8 @@ package body Prj.Nmsc is
Unit : out Name_Id; Unit : out Name_Id;
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref)
is is
Filename : constant String := Get_Name_String (File_Name); Filename : constant String := Get_Name_String (File_Name);
Last : Integer := Filename'Last; Last : Integer := Filename'Last;
Sep_Len : constant Integer := Sep_Len : constant Integer :=
Integer (Length_Of_Name (Naming.Separate_Suffix)); Integer (Length_Of_Name (Naming.Separate_Suffix));
Body_Len : constant Integer := Body_Len : constant Integer :=
...@@ -6346,11 +6349,11 @@ package body Prj.Nmsc is ...@@ -6346,11 +6349,11 @@ package body Prj.Nmsc is
Unit_Kind := Spec; Unit_Kind := Spec;
else else
Compute_Unit_Name Compute_Unit_Name
(File_Name => Canonical_File_Name, (File_Name => Canonical_File_Name,
Naming => Lang.Config.Naming_Data, Naming => Lang.Config.Naming_Data,
Kind => Kind, Kind => Kind,
Unit => Unit_Name, Unit => Unit_Name,
In_Tree => In_Tree); In_Tree => In_Tree);
case Kind is case Kind is
when Spec => Unit_Kind := Spec; when Spec => Unit_Kind := Spec;
...@@ -6594,8 +6597,7 @@ package body Prj.Nmsc is ...@@ -6594,8 +6597,7 @@ package body Prj.Nmsc is
Locally_Removed : Boolean := False; Locally_Removed : Boolean := False;
begin begin
-- If Excluded_Source_Files is not declared, check -- If Excluded_Source_Files is not declared, check Locally_Removed_Files
-- Locally_Removed_Files.
if Excluded_Sources.Default then if Excluded_Sources.Default then
Locally_Removed := True; Locally_Removed := True;
...@@ -6683,8 +6685,7 @@ package body Prj.Nmsc is ...@@ -6683,8 +6685,7 @@ package body Prj.Nmsc is
then then
Name_Len := Last; Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Line (1 .. Last); Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
Canonical_Case_File_Name Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
(Name_Buffer (1 .. Name_Len));
Name := Name_Find; Name := Name_Find;
-- Check that there is no directory information -- Check that there is no directory information
...@@ -6726,18 +6727,19 @@ package body Prj.Nmsc is ...@@ -6726,18 +6727,19 @@ package body Prj.Nmsc is
Proc_Data : in out Processing_Data; Proc_Data : in out Processing_Data;
Allow_Duplicate_Basenames : Boolean) Allow_Duplicate_Basenames : Boolean)
is is
Sources : constant Variable_Value := Sources : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_Files, (Name_Source_Files,
Project.Decl.Attributes, Project.Decl.Attributes,
In_Tree); In_Tree);
Source_List_File : constant Variable_Value := Source_List_File : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_List_File, (Name_Source_List_File,
Project.Decl.Attributes, Project.Decl.Attributes,
In_Tree); In_Tree);
Name_Loc : Name_Location;
Name_Loc : Name_Location;
Has_Explicit_Sources : Boolean; Has_Explicit_Sources : Boolean;
begin begin
...@@ -6913,12 +6915,21 @@ package body Prj.Nmsc is ...@@ -6913,12 +6915,21 @@ package body Prj.Nmsc is
and then Source.Path = No_Path_Information and then Source.Path = No_Path_Information
then then
if Source.Unit /= No_Unit_Index then if Source.Unit /= No_Unit_Index then
Error_Msg_Name_1 := Name_Id (Source.Display_File);
Error_Msg_Name_2 := Name_Id (Source.Unit.Name); -- ??? Current limitation of gprbuild will display this
Error_Msg -- error message for multi-unit source files, because not
(Project, In_Tree, -- all instances of the file have had their path fully set.
"source file %% for unit %% not found",
No_Location); if Source.Index = 0
or else Source.Index = 1
then
Error_Msg_Name_1 := Name_Id (Source.Display_File);
Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
Error_Msg
(Project, In_Tree,
"source file %% for unit %% not found",
No_Location);
end if;
end if; end if;
Remove_Source (Source, No_Source); Remove_Source (Source, No_Source);
...@@ -7060,10 +7071,9 @@ package body Prj.Nmsc is ...@@ -7060,10 +7071,9 @@ package body Prj.Nmsc is
-- ??? We could probably optimize the following call: we -- ??? We could probably optimize the following call: we
-- need to resolve links only once for the directory itself, -- need to resolve links only once for the directory itself,
-- and then do a single call to readlink() for each file. -- and then do a single call to readlink() for each file.
-- Unfortunately that would require a change in -- Unfortunately that would require Normalize_Pathname to
-- Normalize_Pathname so that it has the option of not -- be changed so that it has the option of not resolving
-- resolving links for its Directory parameter, only for -- links for its Directory parameter, only for Name.
-- Name.
Path : constant String := Path : constant String :=
Normalize_Pathname Normalize_Pathname
...@@ -7447,8 +7457,8 @@ package body Prj.Nmsc is ...@@ -7447,8 +7457,8 @@ package body Prj.Nmsc is
or else or else
(Unit = No_Name and then Source.File = File_Name) (Unit = No_Name and then Source.File = File_Name)
then then
-- Duplication of file/unit in same project is only -- Duplication of file/unit in same project is only allowed
-- allowed if order of source directories is known. -- if order of source directories is known.
if Project = Source.Project then if Project = Source.Project then
if Unit = No_Name then if Unit = No_Name then
...@@ -7585,12 +7595,12 @@ package body Prj.Nmsc is ...@@ -7585,12 +7595,12 @@ package body Prj.Nmsc is
exit when Last = 0; exit when Last = 0;
-- ??? Duplicate system call here, we just did a -- ??? Duplicate system call here, we just did a a
-- a similar one. Maybe Ada.Directories would be more -- similar one. Maybe Ada.Directories would be more
-- appropriate here -- appropriate here.
if Is_Regular_File if Is_Regular_File
(Source_Directory & Name (1 .. Last)) (Source_Directory & Name (1 .. Last))
then then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" Checking "); Write_Str (" Checking ");
...@@ -8126,8 +8136,7 @@ package body Prj.Nmsc is ...@@ -8126,8 +8136,7 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (UData.File_Names (Unit_Kind).Path.Name); File_Name_Type (UData.File_Names (Unit_Kind).Path.Name);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree, "\ project file %%, {", The_Location);
"\ project file %%, {", The_Location);
Err_Vars.Error_Msg_Name_1 := Project.Name; Err_Vars.Error_Msg_Name_1 := Project.Name;
Err_Vars.Error_Msg_File_1 := File_Name_Type (Canonical_Path); Err_Vars.Error_Msg_File_1 := File_Name_Type (Canonical_Path);
...@@ -8164,17 +8173,17 @@ package body Prj.Nmsc is ...@@ -8164,17 +8173,17 @@ package body Prj.Nmsc is
if To_Record then if To_Record then
Files_Htable.Set (Proc_Data.Units, Canonical_File, Project); Files_Htable.Set (Proc_Data.Units, Canonical_File, Project);
Add_Source Add_Source
(Id => Source, (Id => Source,
In_Tree => In_Tree, In_Tree => In_Tree,
Project => Project, Project => Project,
Lang_Id => Ada_Language, Lang_Id => Ada_Language,
File_Name => Canonical_File, File_Name => Canonical_File,
Display_File => File_Name, Display_File => File_Name,
Unit => Unit_Name, Unit => Unit_Name,
Path => (Canonical_Path, Path_Name), Path => (Canonical_Path, Path_Name),
Naming_Exception => Needs_Pragma, Naming_Exception => Needs_Pragma,
Kind => Unit_Kind, Kind => Unit_Kind,
Index => Unit_Ind); Index => Unit_Ind);
Source_Recorded := True; Source_Recorded := True;
end if; end if;
end Record_Unit; end Record_Unit;
......
gcc/ada/sinfo.ads
...@@ -6460,7 +6460,7 @@ package Sinfo is ...@@ -6460,7 +6460,7 @@ package Sinfo is
-- The Ada language does not permit conditional expressions, however -- The Ada language does not permit conditional expressions, however
-- this is under discussion as a possible extension by the ARG, and we -- this is under discussion as a possible extension by the ARG, and we
-- have implemented a form of this capability in GNAT under control of -- have implemented a form of this capability in GNAT under control of
-- the -X switch. The syntax is: -- the -gnatX switch. The syntax is:
-- CONDITIONAL_EXPRESSION ::= -- CONDITIONAL_EXPRESSION ::=
-- if EXPRESSION then EXPRESSION -- if EXPRESSION then EXPRESSION
......
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