Skip to content

R
riscv-gcc-1
Commit 757240b3 by Arnaud Charlet
Options

[multiple changes] 

2009-04-24  Emmanuel Briot  <briot@adacore.com>

	* prj.ads, prj-nmsc.adb (Unit_Project): removed, since in fact we were
	only ever using the Project field.

2009-04-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Build_Instance_Compilation_Unit_Nodes): Do not set
	Body_Required on the generated compilation node. The new node is linked
	to its body, but both share the same file, so we do not set this flag
	on the new unit so as not to create a spurious dependency on a
	non-existent body in the ali file for the instance.

2009-04-24  Robert Dewar  <dewar@adacore.com>

	* make.adb: Minor reformatting

From-SVN: r146725
parent aca53298
Showing with 163 additions and 160 deletions
gcc/ada/ChangeLog
2009-04-24 Emmanuel Briot <briot@adacore.com> 2009-04-24 Emmanuel Briot <briot@adacore.com>
* prj.ads, prj-nmsc.adb (Unit_Project): removed, since in fact we were
only ever using the Project field.
2009-04-24 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Build_Instance_Compilation_Unit_Nodes): Do not set
Body_Required on the generated compilation node. The new node is linked
to its body, but both share the same file, so we do not set this flag
on the new unit so as not to create a spurious dependency on a
non-existent body in the ali file for the instance.
2009-04-24 Robert Dewar <dewar@adacore.com>
* make.adb: Minor reformatting
2009-04-24 Emmanuel Briot <briot@adacore.com>
* prj.adb, prj.ads, prj-nmsc.adb (Check_File, Record_Ada_Source, * prj.adb, prj.ads, prj-nmsc.adb (Check_File, Record_Ada_Source,
Add_Source): merge some code between those. In particular change where Add_Source): merge some code between those. In particular change where
file normalization is done to avoid a few extra calls to file normalization is done to avoid a few extra calls to
......
gcc/ada/make.adb
...@@ -6574,9 +6574,10 @@ package body Make is ...@@ -6574,9 +6574,10 @@ package body Make is
declare declare
Dir_Path : constant String := Dir_Path : constant String :=
Get_Name_String Get_Name_String
(Project_Tree.Projects.Table (Project_Tree.Projects.Table
(Main_Project).Directory.Name); (Main_Project).Directory.Name);
begin begin
for for
J in Last_Binder_Switch + 1 .. Binder_Switches.Last J in Last_Binder_Switch + 1 .. Binder_Switches.Last
......
gcc/ada/prj-nmsc.adb
...@@ -492,8 +492,7 @@ package body Prj.Nmsc is ...@@ -492,8 +492,7 @@ package body Prj.Nmsc is
Naming : Naming_Data; Naming : Naming_Data;
Exception_Id : out Ada_Naming_Exception_Id; Exception_Id : out Ada_Naming_Exception_Id;
Unit_Name : out Name_Id; Unit_Name : out Name_Id;
Unit_Kind : out Spec_Or_Body; Unit_Kind : out Spec_Or_Body);
Needs_Pragma : out Boolean);
-- Find out, from a file name, the unit name, the unit kind and if a -- Find out, from a file name, the unit name, the unit kind and if a
-- specific SFN pragma is needed. If the file name corresponds to no unit, -- specific SFN pragma is needed. If the file name corresponds to no unit,
-- then Unit_Name will be No_Name. If the file is a multi-unit source or an -- then Unit_Name will be No_Name. If the file is a multi-unit source or an
...@@ -4555,7 +4554,7 @@ package body Prj.Nmsc is ...@@ -4555,7 +4554,7 @@ package body Prj.Nmsc is
Interface_ALIs : String_List_Id := Nil_String; Interface_ALIs : String_List_Id := Nil_String;
Unit : Name_Id; Unit : Name_Id;
The_Unit_Id : Unit_Index; The_Unit_Id : Unit_Index;
The_Unit_Data : Unit_Data; UData : Unit_Data;
procedure Add_ALI_For (Source : File_Name_Type); procedure Add_ALI_For (Source : File_Name_Type);
-- Add an ALI file name to the list of Interface ALIs -- Add an ALI file name to the list of Interface ALIs
...@@ -4642,23 +4641,23 @@ package body Prj.Nmsc is ...@@ -4642,23 +4641,23 @@ package body Prj.Nmsc is
else else
-- Check that the unit is part of the project -- Check that the unit is part of the project
The_Unit_Data := UData := In_Tree.Units.Table (The_Unit_Id);
In_Tree.Units.Table (The_Unit_Id);
if The_Unit_Data.File_Names (Body_Part).Name /= No_File if UData.File_Names (Body_Part).Name /= No_File
and then The_Unit_Data.File_Names and then
(Body_Part).Path.Name /= Slash UData.File_Names (Body_Part).Path.Name /=
Slash
then then
if Check_Project if Check_Project
(The_Unit_Data.File_Names (Body_Part).Project, (UData.File_Names (Body_Part).Project,
Project, In_Tree, Extending) Project, In_Tree, Extending)
then then
-- There is a body for this unit. -- There is a body for this unit.
-- If there is no spec, we need to check that it -- If there is no spec, we need to check that it
-- is not a subunit. -- is not a subunit.
if The_Unit_Data.File_Names if UData.File_Names (Specification).Name =
(Specification).Name = No_File No_File
then then
declare declare
Src_Ind : Source_File_Index; Src_Ind : Source_File_Index;
...@@ -4666,7 +4665,7 @@ package body Prj.Nmsc is ...@@ -4666,7 +4665,7 @@ package body Prj.Nmsc is
begin begin
Src_Ind := Sinput.P.Load_Project_File Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(The_Unit_Data.File_Names (UData.File_Names
(Body_Part).Path.Name)); (Body_Part).Path.Name));
if Sinput.P.Source_File_Is_Subunit if Sinput.P.Source_File_Is_Subunit
...@@ -4687,7 +4686,7 @@ package body Prj.Nmsc is ...@@ -4687,7 +4686,7 @@ package body Prj.Nmsc is
-- ALI file for its body to the Interface ALIs. -- ALI file for its body to the Interface ALIs.
Add_ALI_For Add_ALI_For
(The_Unit_Data.File_Names (Body_Part).Name); (UData.File_Names (Body_Part).Name);
else else
Error_Msg Error_Msg
...@@ -4697,12 +4696,12 @@ package body Prj.Nmsc is ...@@ -4697,12 +4696,12 @@ package body Prj.Nmsc is
(Interfaces).Location); (Interfaces).Location);
end if; end if;
elsif The_Unit_Data.File_Names elsif UData.File_Names (Specification).Name /=
(Specification).Name /= No_File No_File
and then The_Unit_Data.File_Names and then UData.File_Names
(Specification).Path.Name /= Slash (Specification).Path.Name /= Slash
and then Check_Project and then Check_Project
(The_Unit_Data.File_Names (UData.File_Names
(Specification).Project, (Specification).Project,
Project, In_Tree, Extending) Project, In_Tree, Extending)
...@@ -4712,7 +4711,7 @@ package body Prj.Nmsc is ...@@ -4712,7 +4711,7 @@ package body Prj.Nmsc is
-- Interface ALIs. -- Interface ALIs.
Add_ALI_For Add_ALI_For
(The_Unit_Data.File_Names (Specification).Name); (UData.File_Names (Specification).Name);
else else
Error_Msg Error_Msg
...@@ -6481,8 +6480,7 @@ package body Prj.Nmsc is ...@@ -6481,8 +6480,7 @@ package body Prj.Nmsc is
Naming : Naming_Data; Naming : Naming_Data;
Exception_Id : out Ada_Naming_Exception_Id; Exception_Id : out Ada_Naming_Exception_Id;
Unit_Name : out Name_Id; Unit_Name : out Name_Id;
Unit_Kind : out Spec_Or_Body; Unit_Kind : out Spec_Or_Body)
Needs_Pragma : out Boolean)
is is
Info_Id : Ada_Naming_Exception_Id := Info_Id : Ada_Naming_Exception_Id :=
Ada_Naming_Exceptions.Get (Canonical_File_Name); Ada_Naming_Exceptions.Get (Canonical_File_Name);
...@@ -6508,9 +6506,8 @@ package body Prj.Nmsc is ...@@ -6508,9 +6506,8 @@ package body Prj.Nmsc is
Exception_Id := Info_Id; Exception_Id := Info_Id;
Unit_Name := No_Name; Unit_Name := No_Name;
Unit_Kind := Specification; Unit_Kind := Specification;
Needs_Pragma := True;
else else
Needs_Pragma := False;
Exception_Id := No_Ada_Naming_Exception; Exception_Id := No_Ada_Naming_Exception;
Compute_Unit_Name Compute_Unit_Name
(File_Name => Canonical_File_Name, (File_Name => Canonical_File_Name,
...@@ -6594,12 +6591,9 @@ package body Prj.Nmsc is ...@@ -6594,12 +6591,9 @@ package body Prj.Nmsc is
is is
The_Parent : constant String := The_Parent : constant String :=
Get_Name_String (Parent) & Directory_Separator; Get_Name_String (Parent) & Directory_Separator;
The_Parent_Last : constant Natural := The_Parent_Last : constant Natural :=
Compute_Directory_Last (The_Parent); Compute_Directory_Last (The_Parent);
Full_Name : File_Name_Type; Full_Name : File_Name_Type;
The_Name : File_Name_Type; The_Name : File_Name_Type;
begin begin
...@@ -6657,6 +6651,7 @@ package body Prj.Nmsc is ...@@ -6657,6 +6651,7 @@ package body Prj.Nmsc is
and then Create'Length > 0 and then Create'Length > 0
then then
if not Is_Directory (Full_Path_Name.all) then if not Is_Directory (Full_Path_Name.all) then
-- If project is externally built, do not create a subdir, -- If project is externally built, do not create a subdir,
-- use the specified directory, without the subdir. -- use the specified directory, without the subdir.
...@@ -6794,8 +6789,8 @@ package body Prj.Nmsc is ...@@ -6794,8 +6789,8 @@ package body Prj.Nmsc is
Element := In_Tree.String_Elements.Table (Current); Element := In_Tree.String_Elements.Table (Current);
Name := Canonical_Case_File_Name (Element.Value); Name := Canonical_Case_File_Name (Element.Value);
-- If the element has no location, then use the location -- If the element has no location, then use the location of
-- of Excluded_Sources to report possible errors. -- Excluded_Sources to report possible errors.
if Element.Location = No_Location then if Element.Location = No_Location then
Location := Excluded_Sources.Location; Location := Excluded_Sources.Location;
...@@ -6840,8 +6835,7 @@ package body Prj.Nmsc is ...@@ -6840,8 +6835,7 @@ package body Prj.Nmsc is
while not Prj.Util.End_Of_File (File) loop while not Prj.Util.End_Of_File (File) loop
Prj.Util.Get_Line (File, Line, Last); Prj.Util.Get_Line (File, Line, Last);
-- A non empty, non comment line should contain a file -- Non empty, non comment line should contain a file name
-- name
if Last /= 0 if Last /= 0
and then (Last = 1 or else Line (1 .. 2) /= "--") and then (Last = 1 or else Line (1 .. 2) /= "--")
...@@ -6886,9 +6880,9 @@ package body Prj.Nmsc is ...@@ -6886,9 +6880,9 @@ package body Prj.Nmsc is
------------------ ------------------
procedure Find_Sources procedure Find_Sources
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data) Data : in out Project_Data)
is is
Sources : constant Variable_Value := Sources : constant Variable_Value :=
Util.Value_Of Util.Value_Of
...@@ -6901,6 +6895,7 @@ package body Prj.Nmsc is ...@@ -6901,6 +6895,7 @@ package body Prj.Nmsc is
Data.Decl.Attributes, Data.Decl.Attributes,
In_Tree); In_Tree);
Name_Loc : Name_Location; Name_Loc : Name_Location;
Has_Explicit_Sources : Boolean; Has_Explicit_Sources : Boolean;
begin begin
...@@ -6933,10 +6928,9 @@ package body Prj.Nmsc is ...@@ -6933,10 +6928,9 @@ package body Prj.Nmsc is
if Current = Nil_String then if Current = Nil_String then
Data.Languages := No_Language_Index; Data.Languages := No_Language_Index;
-- This project contains no source. For projects that -- This project contains no source. For projects that don't
-- don't extend other projects, this also means that -- extend other projects, this also means that there is no
-- there is no need for an object directory, if not -- need for an object directory, if not specified.
-- specified.
if Data.Extends = No_Project if Data.Extends = No_Project
and then Data.Object_Directory = Data.Directory and then Data.Object_Directory = Data.Directory
...@@ -6951,8 +6945,8 @@ package body Prj.Nmsc is ...@@ -6951,8 +6945,8 @@ package body Prj.Nmsc is
Name := Canonical_Case_File_Name (Element.Value); Name := Canonical_Case_File_Name (Element.Value);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
-- If the element has no location, then use the -- If the element has no location, then use the location of
-- location of Sources to report possible errors. -- Sources to report possible errors.
if Element.Location = No_Location then if Element.Location = No_Location then
Location := Sources.Location; Location := Sources.Location;
...@@ -6977,10 +6971,10 @@ package body Prj.Nmsc is ...@@ -6977,10 +6971,10 @@ package body Prj.Nmsc is
end if; end if;
end loop; end loop;
-- In Multi_Language mode, check whether the file is -- In Multi_Language mode, check whether the file is already
-- already there: the same file name may be in the list; if -- there: the same file name may be in the list. If the source
-- the source is missing, the error will be on the first -- is missing, the error will be on the first mention of the
-- mention of the source file name. -- source file name.
case Get_Mode is case Get_Mode is
when Ada_Only => when Ada_Only =>
...@@ -7006,12 +7000,12 @@ package body Prj.Nmsc is ...@@ -7006,12 +7000,12 @@ package body Prj.Nmsc is
end; end;
-- If we have no Source_Files attribute, check the Source_List_File -- If we have no Source_Files attribute, check the Source_List_File
-- attribute -- attribute.
elsif not Source_List_File.Default then elsif not Source_List_File.Default then
-- Source_List_File is the name of the file -- Source_List_File is the name of the file that contains the source
-- that contains the source file names -- file names.
declare declare
Source_File_Path_Name : constant String := Source_File_Path_Name : constant String :=
...@@ -7037,9 +7031,9 @@ package body Prj.Nmsc is ...@@ -7037,9 +7031,9 @@ package body Prj.Nmsc is
end; end;
else else
-- Neither Source_Files nor Source_List_File has been -- Neither Source_Files nor Source_List_File has been specified. Find
-- specified. Find all the files that satisfy the naming -- all the files that satisfy the naming scheme in all the source
-- scheme in all the source directories. -- directories.
Has_Explicit_Sources := False; Has_Explicit_Sources := False;
end if; end if;
...@@ -7056,9 +7050,9 @@ package body Prj.Nmsc is ...@@ -7056,9 +7050,9 @@ package body Prj.Nmsc is
Sources.Default and then Source_List_File.Default); Sources.Default and then Source_List_File.Default);
end if; end if;
-- Check if all exceptions have been found. -- Check if all exceptions have been found. For Ada, it is an error if
-- For Ada, it is an error if an exception is not found. -- an exception is not found. For other language, the source is simply
-- For other language, the source is simply removed. -- removed.
declare declare
Source : Source_Id; Source : Source_Id;
...@@ -7089,15 +7083,17 @@ package body Prj.Nmsc is ...@@ -7089,15 +7083,17 @@ package body Prj.Nmsc is
end loop; end loop;
end; end;
-- It is an error if a source file name in a source list or in a -- It is an error if a source file name in a source list or in a source
-- source list file is not found. -- list file is not found.
if Has_Explicit_Sources then if Has_Explicit_Sources then
declare declare
NL : Name_Location; NL : Name_Location;
First_Error : Boolean := True; First_Error : Boolean;
begin begin
NL := Source_Names.Get_First; NL := Source_Names.Get_First;
First_Error := True;
while NL /= No_Name_Location loop while NL /= No_Name_Location loop
if not NL.Found then if not NL.Found then
Err_Vars.Error_Msg_File_1 := NL.Name; Err_Vars.Error_Msg_File_1 := NL.Name;
...@@ -7144,12 +7140,12 @@ package body Prj.Nmsc is ...@@ -7144,12 +7140,12 @@ package body Prj.Nmsc is
Data : in out Project_Data; Data : in out Project_Data;
Explicit_Sources_Only : Boolean) Explicit_Sources_Only : Boolean)
is is
Source_Dir : String_List_Id; Source_Dir : String_List_Id;
Element : String_Element; Element : String_Element;
Dir : Dir_Type; Dir : Dir_Type;
Dir_Has_Source : Boolean := False; Dir_Has_Source : Boolean := False;
NL : Name_Location; NL : Name_Location;
Ada_Language : Language_Ptr; Ada_Language : Language_Ptr;
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -7173,8 +7169,10 @@ package body Prj.Nmsc is ...@@ -7173,8 +7169,10 @@ package body Prj.Nmsc is
declare declare
Dir_Path : constant String := Dir_Path : constant String :=
Get_Name_String (Element.Display_Value) & Directory_Separator; Get_Name_String (Element.Display_Value) &
Dir_Last : constant Natural := Compute_Directory_Last (Dir_Path); Directory_Separator;
Dir_Last : constant Natural := Compute_Directory_Last (Dir_Path);
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line ("checking directory """ & Dir_Path & """"); Write_Line ("checking directory """ & Dir_Path & """");
...@@ -7196,13 +7194,13 @@ package body Prj.Nmsc is ...@@ -7196,13 +7194,13 @@ package body Prj.Nmsc is
Name : constant File_Name_Type := Name_Find; Name : constant File_Name_Type := Name_Find;
Canonical_Name : File_Name_Type; Canonical_Name : File_Name_Type;
-- ??? We could probably optimize the following call: -- ??? We could probably optimize the following call: we
-- we need to resolve links only once for the -- need to resolve links only once for the directory itself,
-- directory itself, and then do a single call to -- and then do a single call to readlink() for each file.
-- readlink() for each file. Unfortunately that would -- Unfortunately that would require a change in
-- require a change in Normalize_Pathname so that it -- Normalize_Pathname so that it has the option of not
-- has the option of not resolving links for its -- resolving links for its Directory parameter, only for
-- Directory parameter, only for Name. -- Name.
Path : constant String := Path : constant String :=
Normalize_Pathname Normalize_Pathname
...@@ -7221,10 +7219,11 @@ package body Prj.Nmsc is ...@@ -7221,10 +7219,11 @@ package body Prj.Nmsc is
-- an explicit source was not found) -- an explicit source was not found)
if Explicit_Sources_Only then if Explicit_Sources_Only then
Canonical_Name := Canonical_Case_File_Name Canonical_Name :=
(Name_Id (Name)); Canonical_Case_File_Name (Name_Id (Name));
NL := Source_Names.Get (Canonical_Name); NL := Source_Names.Get (Canonical_Name);
To_Record := NL /= No_Name_Location and then not NL.Found; To_Record := NL /= No_Name_Location and then not NL.Found;
if To_Record then if To_Record then
NL.Found := True; NL.Found := True;
Location := NL.Location; Location := NL.Location;
...@@ -7436,18 +7435,19 @@ package body Prj.Nmsc is ...@@ -7436,18 +7435,19 @@ package body Prj.Nmsc is
For_All_Sources : Boolean) For_All_Sources : Boolean)
is is
Canonical_Path : constant Path_Name_Type := Canonical_Path : constant Path_Name_Type :=
Path_Name_Type (Canonical_Case_File_Name (Name_Id (Path))); Path_Name_Type
Name_Loc : Name_Location := Source_Names.Get (File_Name); (Canonical_Case_File_Name (Name_Id (Path)));
Check_Name : Boolean := False;
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language; Name_Loc : Name_Location := Source_Names.Get (File_Name);
Language : Language_Ptr; Check_Name : Boolean := False;
Source : Source_Id; Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
Other_Part : Source_Id; Language : Language_Ptr;
Add_Src : Boolean; Source : Source_Id;
Src_Ind : Source_File_Index; Other_Part : Source_Id;
Unit : Name_Id; Add_Src : Boolean;
Source_To_Replace : Source_Id := No_Source; Src_Ind : Source_File_Index;
Unit : Name_Id;
Source_To_Replace : Source_Id := No_Source;
Language_Name : Name_Id; Language_Name : Name_Id;
Display_Language_Name : Name_Id; Display_Language_Name : Name_Id;
Lang_Kind : Language_Kind; Lang_Kind : Language_Kind;
...@@ -7545,8 +7545,8 @@ package body Prj.Nmsc is ...@@ -7545,8 +7545,8 @@ package body Prj.Nmsc is
and then Source.Unit = Unit and then Source.Unit = Unit
and then and then
((Source.Kind = Spec and then Kind = Impl) ((Source.Kind = Spec and then Kind = Impl)
or else or else
(Source.Kind = Impl and then Kind = Spec)) (Source.Kind = Impl and then Kind = Spec))
then then
Other_Part := Source; Other_Part := Source;
...@@ -7554,10 +7554,10 @@ package body Prj.Nmsc is ...@@ -7554,10 +7554,10 @@ package body Prj.Nmsc is
and then Source.Unit = Unit and then Source.Unit = Unit
and then and then
(Source.Kind = Kind (Source.Kind = Kind
or else or else
(Source.Kind = Sep and then Kind = Impl) (Source.Kind = Sep and then Kind = Impl)
or else or else
(Source.Kind = Impl and then Kind = Sep))) (Source.Kind = Impl and then Kind = Sep)))
or else or else
(Unit = No_Name and then Source.File = File_Name) (Unit = No_Name and then Source.File = File_Name)
then then
...@@ -7583,17 +7583,14 @@ package body Prj.Nmsc is ...@@ -7583,17 +7583,14 @@ package body Prj.Nmsc is
Add_Src := False; Add_Src := False;
end if; end if;
-- Do not allow the same unit name in different -- Do not allow the same unit name in different projects,
-- projects, except if one is extending the other. -- except if one is extending the other.
-- For a file based language, the same file name -- For a file based language, the same file name replaces
-- replaces a file in a project being extended, but -- a file in a project being extended, but it is allowed
-- it is allowed to have the same file name in -- to have the same file name in unrelated projects.
-- unrelated projects.
elsif Is_Extending elsif Is_Extending (Project, Source.Project, In_Tree) then
(Project, Source.Project, In_Tree)
then
Source_To_Replace := Source; Source_To_Replace := Source;
elsif Unit /= No_Name elsif Unit /= No_Name
...@@ -7731,10 +7728,10 @@ package body Prj.Nmsc is ...@@ -7731,10 +7728,10 @@ package body Prj.Nmsc is
(Source_Directory'First .. Dir_Last), (Source_Directory'First .. Dir_Last),
Resolve_Links => Opt.Follow_Links_For_Files, Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => True); -- no folding Case_Sensitive => True); -- no folding
Path : Path_Name_Type;
FF : File_Found := Path : Path_Name_Type;
Excluded_Sources_Htable.Get (File_Name); FF : File_Found :=
Excluded_Sources_Htable.Get (File_Name);
begin begin
Name_Len := Path_Name'Length; Name_Len := Path_Name'Length;
...@@ -7744,8 +7741,7 @@ package body Prj.Nmsc is ...@@ -7744,8 +7741,7 @@ package body Prj.Nmsc is
if FF /= No_File_Found then if FF /= No_File_Found then
if not FF.Found then if not FF.Found then
FF.Found := True; FF.Found := True;
Excluded_Sources_Htable.Set Excluded_Sources_Htable.Set (File_Name, FF);
(File_Name, FF);
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" excluded source """); Write_Str (" excluded source """);
...@@ -8196,7 +8192,7 @@ package body Prj.Nmsc is ...@@ -8196,7 +8192,7 @@ package body Prj.Nmsc is
Canonical_File : File_Name_Type; Canonical_File : File_Name_Type;
Canonical_Path : Path_Name_Type; Canonical_Path : Path_Name_Type;
File_Recorded : Boolean := False; File_Recorded : Boolean := False;
-- True when at least one file has been recorded -- True when at least one file has been recorded
procedure Record_Unit procedure Record_Unit
...@@ -8219,13 +8215,13 @@ package body Prj.Nmsc is ...@@ -8219,13 +8215,13 @@ package body Prj.Nmsc is
Needs_Pragma : Boolean) Needs_Pragma : Boolean)
is is
The_Unit : Unit_Index := The_Unit : Unit_Index :=
Units_Htable.Get (In_Tree.Units_HT, Unit_Name); Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
UData : Unit_Data; UData : Unit_Data;
Kind : Source_Kind; Kind : Source_Kind;
Source : Source_Id; Source : Source_Id;
Unit_Prj : Unit_Project;
To_Record : Boolean := False; To_Record : Boolean := False;
The_Location : Source_Ptr := Location; The_Location : Source_Ptr := Location;
Unit_Prj : Project_Id;
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -8242,7 +8238,7 @@ package body Prj.Nmsc is ...@@ -8242,7 +8238,7 @@ package body Prj.Nmsc is
UData := In_Tree.Units.Table (The_Unit); UData := In_Tree.Units.Table (The_Unit);
if (UData.File_Names (Unit_Kind).Name = Canonical_File if (UData.File_Names (Unit_Kind).Name = Canonical_File
and then UData.File_Names (Unit_Kind).Path.Name = Slash) and then UData.File_Names (Unit_Kind).Path.Name = Slash)
or else UData.File_Names (Unit_Kind).Name = No_File or else UData.File_Names (Unit_Kind).Name = No_File
or else Is_Extending or else Is_Extending
(Data.Extends, (Data.Extends,
...@@ -8256,11 +8252,7 @@ package body Prj.Nmsc is ...@@ -8256,11 +8252,7 @@ package body Prj.Nmsc is
-- Record the file name in the hash table Files_Htable -- Record the file name in the hash table Files_Htable
Unit_Prj := (Unit => The_Unit, Project => Project); Files_Htable.Set (In_Tree.Files_HT, Canonical_File, Project);
Files_Htable.Set
(In_Tree.Files_HT,
Canonical_File,
Unit_Prj);
UData.File_Names (Unit_Kind) := UData.File_Names (Unit_Kind) :=
(Name => Canonical_File, (Name => Canonical_File,
...@@ -8278,8 +8270,8 @@ package body Prj.Nmsc is ...@@ -8278,8 +8270,8 @@ package body Prj.Nmsc is
elsif UData.File_Names (Unit_Kind).Project = Project elsif UData.File_Names (Unit_Kind).Project = Project
and then and then
(Data.Known_Order_Of_Source_Dirs (Data.Known_Order_Of_Source_Dirs
or else or else
UData.File_Names (Unit_Kind).Path.Name = Canonical_Path) UData.File_Names (Unit_Kind).Path.Name = Canonical_Path)
then then
To_Record := False; To_Record := False;
...@@ -8323,11 +8315,10 @@ package body Prj.Nmsc is ...@@ -8323,11 +8315,10 @@ package body Prj.Nmsc is
Unit_Prj := Files_Htable.Get (In_Tree.Files_HT, Canonical_File); Unit_Prj := Files_Htable.Get (In_Tree.Files_HT, Canonical_File);
if not File_Recorded if not File_Recorded
and then Unit_Prj /= No_Unit_Project and then Unit_Prj /= No_Project
then then
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg_Name_1 := Error_Msg_Name_1 := In_Tree.Projects.Table (Unit_Prj).Name;
In_Tree.Projects.Table (Unit_Prj.Project).Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is already a source of project %%", "{ is already a source of project %%",
...@@ -8338,8 +8329,7 @@ package body Prj.Nmsc is ...@@ -8338,8 +8329,7 @@ package body Prj.Nmsc is
The_Unit := Unit_Table.Last (In_Tree.Units); The_Unit := Unit_Table.Last (In_Tree.Units);
Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit); Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit);
Unit_Prj := (Unit => The_Unit, Project => Project); Files_Htable.Set (In_Tree.Files_HT, Canonical_File, Project);
Files_Htable.Set (In_Tree.Files_HT, Canonical_File, Unit_Prj);
UData.Name := Unit_Name; UData.Name := Unit_Name;
UData.File_Names (Unit_Kind) := UData.File_Names (Unit_Kind) :=
...@@ -8399,8 +8389,9 @@ package body Prj.Nmsc is ...@@ -8399,8 +8389,9 @@ package body Prj.Nmsc is
Naming => Data.Naming, Naming => Data.Naming,
Exception_Id => Exception_Id, Exception_Id => Exception_Id,
Unit_Name => Unit_Name, Unit_Name => Unit_Name,
Unit_Kind => Unit_Kind, Unit_Kind => Unit_Kind);
Needs_Pragma => Needs_Pragma);
Needs_Pragma := Exception_Id /= No_Ada_Naming_Exception;
if Exception_Id = No_Ada_Naming_Exception if Exception_Id = No_Ada_Naming_Exception
and then Unit_Name = No_Name and then Unit_Name = No_Name
...@@ -8430,8 +8421,8 @@ package body Prj.Nmsc is ...@@ -8430,8 +8421,8 @@ package body Prj.Nmsc is
Write_Line (""" (ignored)."); Write_Line (""" (ignored).");
end if; end if;
-- The file is not included in the source of the project since -- The file is not included in the source of the project since it
-- it is hidden by the exception. So, nothing else to do. -- is hidden by the exception. So, nothing else to do.
return; return;
end if; end if;
...@@ -8469,7 +8460,7 @@ package body Prj.Nmsc is ...@@ -8469,7 +8460,7 @@ package body Prj.Nmsc is
(Id : Source_Id; (Id : Source_Id;
Replaced_By : Source_Id) Replaced_By : Source_Id)
is is
Source : Source_Id; Source : Source_Id;
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -8523,12 +8514,9 @@ package body Prj.Nmsc is ...@@ -8523,12 +8514,9 @@ package body Prj.Nmsc is
Error_Msg_Warn := When_No_Sources = Warning; Error_Msg_Warn := When_No_Sources = Warning;
if Continuation then if Continuation then
Error_Msg Error_Msg (Project, In_Tree, "\" & Msg, Location);
(Project, In_Tree, "\" & Msg, Location);
else else
Error_Msg Error_Msg (Project, In_Tree, Msg, Location);
(Project, In_Tree, Msg, Location);
end if; end if;
end; end;
end case; end case;
......
gcc/ada/prj.ads
...@@ -1406,17 +1406,10 @@ package Prj is ...@@ -1406,17 +1406,10 @@ package Prj is
Equal => "="); Equal => "=");
-- Mapping of unit names to indexes in the Units table -- Mapping of unit names to indexes in the Units table
type Unit_Project is record
Unit : Unit_Index := No_Unit_Index;
Project : Project_Id := No_Project;
end record;
No_Unit_Project : constant Unit_Project := (No_Unit_Index, No_Project);
package Files_Htable is new Simple_HTable package Files_Htable is new Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Unit_Project, Element => Project_Id,
No_Element => No_Unit_Project, No_Element => No_Project,
Key => File_Name_Type, Key => File_Name_Type,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
......
gcc/ada/sem_ch12.adb
...@@ -885,10 +885,13 @@ package body Sem_Ch12 is ...@@ -885,10 +885,13 @@ package body Sem_Ch12 is
Formals : List_Id; Formals : List_Id;
F_Copy : List_Id) return List_Id F_Copy : List_Id) return List_Id
is is
Actual_Types : constant Elist_Id := New_Elmt_List;
Assoc : constant List_Id := New_List; Actual_Types : constant Elist_Id := New_Elmt_List;
Assoc : constant List_Id := New_List;
Default_Actuals : constant Elist_Id := New_Elmt_List; Default_Actuals : constant Elist_Id := New_Elmt_List;
Gen_Unit : constant Entity_Id := Defining_Entity (Parent (F_Copy)); Gen_Unit : constant Entity_Id
:= Defining_Entity (Parent (F_Copy));
Actuals : List_Id; Actuals : List_Id;
Actual : Node_Id; Actual : Node_Id;
Formal : Node_Id; Formal : Node_Id;
...@@ -905,16 +908,16 @@ package body Sem_Ch12 is ...@@ -905,16 +908,16 @@ package body Sem_Ch12 is
-- individual defaults for each such formal. These defaults are -- individual defaults for each such formal. These defaults are
-- appended to the list of associations and replace the Others_Choice. -- appended to the list of associations and replace the Others_Choice.
Found_Assoc : Node_Id; Found_Assoc : Node_Id;
-- Association for the current formal being match. Empty if there are -- Association for the current formal being match. Empty if there are
-- no remaining actuals, or if there is no named association with the -- no remaining actuals, or if there is no named association with the
-- name of the formal. -- name of the formal.
Is_Named_Assoc : Boolean; Is_Named_Assoc : Boolean;
Num_Matched : Int := 0; Num_Matched : Int := 0;
Num_Actuals : Int := 0; Num_Actuals : Int := 0;
Others_Present : Boolean := False; Others_Present : Boolean := False;
-- In Ada 2005, indicates partial parametrization of a formal -- In Ada 2005, indicates partial parametrization of a formal
-- package. As usual an other association must be last in the list. -- package. As usual an other association must be last in the list.
...@@ -1047,7 +1050,6 @@ package body Sem_Ch12 is ...@@ -1047,7 +1050,6 @@ package body Sem_Ch12 is
procedure Process_Default (F : Entity_Id) is procedure Process_Default (F : Entity_Id) is
Loc : constant Source_Ptr := Sloc (I_Node); Loc : constant Source_Ptr := Sloc (I_Node);
F_Id : constant Entity_Id := Defining_Entity (F); F_Id : constant Entity_Id := Defining_Entity (F);
Decl : Node_Id; Decl : Node_Id;
Default : Node_Id; Default : Node_Id;
Id : Entity_Id; Id : Entity_Id;
...@@ -1132,7 +1134,7 @@ package body Sem_Ch12 is ...@@ -1132,7 +1134,7 @@ package body Sem_Ch12 is
if Present (Actuals) then if Present (Actuals) then
-- check for an Others choice, indicating a partial parametrization -- Check for an Others choice, indicating a partial parametrization
-- for a formal package. -- for a formal package.
Actual := First (Actuals); Actual := First (Actuals);
...@@ -1292,11 +1294,10 @@ package body Sem_Ch12 is ...@@ -1292,11 +1294,10 @@ package body Sem_Ch12 is
Defining_Unit_Name (Specification (Formal)), Defining_Unit_Name (Specification (Formal)),
Defining_Unit_Name (Specification (Analyzed_Formal))); Defining_Unit_Name (Specification (Analyzed_Formal)));
-- If the formal subprogram has the same name as -- If the formal subprogram has the same name as another
-- another formal subprogram of the generic, then -- formal subprogram of the generic, then a named
-- a named association is illegal (12.3(9)). Exclude -- association is illegal (12.3(9)). Exclude named
-- named associations that are generated for a nested -- associations that are generated for a nested instance.
-- instance.
if Present (Match) if Present (Match)
and then Is_Named_Assoc and then Is_Named_Assoc
...@@ -1424,7 +1425,6 @@ package body Sem_Ch12 is ...@@ -1424,7 +1425,6 @@ package body Sem_Ch12 is
declare declare
Elmt : Elmt_Id := First_Elmt (Actual_Types); Elmt : Elmt_Id := First_Elmt (Actual_Types);
begin begin
while Present (Elmt) loop while Present (Elmt) loop
Freeze_Before (I_Node, Node (Elmt)); Freeze_Before (I_Node, Node (Elmt));
...@@ -1934,7 +1934,6 @@ package body Sem_Ch12 is ...@@ -1934,7 +1934,6 @@ package body Sem_Ch12 is
("initialization not allowed for `IN OUT` formals", N); ("initialization not allowed for `IN OUT` formals", N);
end if; end if;
end if; end if;
end Analyze_Formal_Object_Declaration; end Analyze_Formal_Object_Declaration;
---------------------------------------------- ----------------------------------------------
...@@ -1984,7 +1983,7 @@ package body Sem_Ch12 is ...@@ -1984,7 +1983,7 @@ package body Sem_Ch12 is
procedure Analyze_Formal_Package (N : Node_Id) is procedure Analyze_Formal_Package (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Pack_Id : constant Entity_Id := Defining_Identifier (N); Pack_Id : constant Entity_Id := Defining_Identifier (N);
Formal : Entity_Id; Formal : Entity_Id;
Gen_Id : constant Node_Id := Name (N); Gen_Id : constant Node_Id := Name (N);
Gen_Decl : Node_Id; Gen_Decl : Node_Id;
...@@ -2039,6 +2038,7 @@ package body Sem_Ch12 is ...@@ -2039,6 +2038,7 @@ package body Sem_Ch12 is
-- create corresponding declarations for all entities in the formal -- create corresponding declarations for all entities in the formal
-- part, so that names with the proper types are available in the -- part, so that names with the proper types are available in the
-- specification of the formal package. -- specification of the formal package.
-- On the other hand, if there are no associations, then all the -- On the other hand, if there are no associations, then all the
-- formals must have defaults, and this will be checked by the -- formals must have defaults, and this will be checked by the
-- call to Analyze_Associations. -- call to Analyze_Associations.
...@@ -4372,7 +4372,11 @@ package body Sem_Ch12 is ...@@ -4372,7 +4372,11 @@ package body Sem_Ch12 is
Make_Compilation_Unit_Aux (Sloc (N))); Make_Compilation_Unit_Aux (Sloc (N)));
Set_Parent_Spec (Act_Decl, Parent_Spec (N)); Set_Parent_Spec (Act_Decl, Parent_Spec (N));
Set_Body_Required (Decl_Cunit, True);
-- The new compilation unit is linked to its body, but both share the
-- same file, so we do not set Body_Required on the new unit so as not
-- to create a spurious dependency on a non-existent body in the ali.
-- This simplifies codepeer unit traversal.
-- We use the original instantiation compilation unit as the resulting -- We use the original instantiation compilation unit as the resulting
-- compilation unit of the instance, since this is the main unit. -- compilation unit of the instance, since this is the main unit.
......
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