[multiple changes]

2010-06-14  Pascal Obry  <obry@adacore.com>

	* s-finimp.adb: Fix typo.
	* raise.h: Remove duplicate blank line.

2010-06-14  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Add_Sources): Always set the object file and the
	switches file names, as the configuration of the language may change
	in an extending project.
	(Process_Naming_Scheme): For sources of projects that are extended, set
	the configuration of the language from the highest extending project
	where the language is declared.

2010-06-14  Gary Dismukes  <dismukes@adacore.com>

	* sem_res.adb (Resolve_Call): For infinite recursion check, test
	whether the called subprogram is inherited from a containing subprogram.
	(Same_Or_Aliased_Subprograms): New function

From-SVN: r160733
This commit is contained in:
Arnaud Charlet 2010-06-14 14:46:56 +02:00
parent a40520ecc5
commit ee81cbe977
5 changed files with 85 additions and 10 deletions

View File

@ -1,3 +1,23 @@
2010-06-14 Pascal Obry <obry@adacore.com>
* s-finimp.adb: Fix typo.
* raise.h: Remove duplicate blank line.
2010-06-14 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Add_Sources): Always set the object file and the
switches file names, as the configuration of the language may change
in an extending project.
(Process_Naming_Scheme): For sources of projects that are extended, set
the configuration of the language from the highest extending project
where the language is declared.
2010-06-14 Gary Dismukes <dismukes@adacore.com>
* sem_res.adb (Resolve_Call): For infinite recursion check, test
whether the called subprogram is inherited from a containing subprogram.
(Same_Or_Aliased_Subprograms): New function
2010-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (End_Use_Type): Before indicating that an operator is not

View File

@ -736,6 +736,9 @@ package body Prj.Nmsc is
Id.Dep_Name := Dependency_Name
(File_Name, Lang_Id.Config.Dependency_Kind);
Id.Naming_Exception := Naming_Exception;
Id.Object := Object_Name
(File_Name, Config.Object_File_Suffix);
Id.Switches := Switches_Name (File_Name);
-- Add the source id to the Unit_Sources_HT hash table, if the unit name
-- is not null.
@ -767,11 +770,6 @@ package body Prj.Nmsc is
Override_Kind (Id, Kind);
end if;
if Is_Compilable (Id) and then Config.Object_Generated then
Id.Object := Object_Name (File_Name, Config.Object_File_Suffix);
Id.Switches := Switches_Name (File_Name);
end if;
if Path /= No_Path_Information then
Id.Path := Path;
Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
@ -7488,6 +7486,45 @@ package body Prj.Nmsc is
Initialize (Data, Tree => Tree, Flags => Flags);
Check_All_Projects (Root_Project, Data, Imported_First => True);
Free (Data);
-- Adjust language configs for projects that are extended
declare
List : Project_List;
Proj : Project_Id;
Exte : Project_Id;
Lang : Language_Ptr;
Elng : Language_Ptr;
begin
List := Tree.Projects;
while List /= null loop
Proj := List.Project;
Exte := Proj;
while Exte.Extended_By /= No_Project loop
Exte := Exte.Extended_By;
end loop;
if Exte /= Proj then
Lang := Proj.Languages;
if Lang /= No_Language_Index then
loop
Elng := Get_Language_From_Name
(Exte, Get_Name_String (Lang.Name));
exit when Elng /= No_Language_Index;
Exte := Exte.Extends;
end loop;
if Elng /= Lang then
Lang.Config := Elng.Config;
end if;
end if;
end if;
List := List.Next;
end loop;
end;
end Process_Naming_Scheme;
end Prj.Nmsc;

View File

@ -29,7 +29,6 @@
* *
****************************************************************************/
/* C counterparts of what System.Standard_Library defines. */
typedef unsigned Exception_Code;

View File

@ -332,10 +332,10 @@ package body System.Finalization_Implementation is
P : Finalizable_Ptr := L;
Q : Finalizable_Ptr;
type Fake_Exception_Occurence is record
type Fake_Exception_Occurrence is record
Id : Exception_Id;
end record;
type Ptr is access all Fake_Exception_Occurence;
type Ptr is access all Fake_Exception_Occurrence;
function To_Ptr is new
Ada.Unchecked_Conversion (Exception_Occurrence_Access, Ptr);

View File

@ -4763,6 +4763,25 @@ package body Sem_Res is
Scop : Entity_Id;
Rtype : Entity_Id;
function Same_Or_Aliased_Subprograms
(S : Entity_Id;
E : Entity_Id) return Boolean;
-- Returns True if the subprogram entity S is the same as E or else
-- S is an alias of E.
function Same_Or_Aliased_Subprograms
(S : Entity_Id;
E : Entity_Id) return Boolean
is
Subp_Alias : constant Entity_Id := Alias (S);
begin
return S = E
or else (Present (Subp_Alias) and then Subp_Alias = E);
end Same_Or_Aliased_Subprograms;
-- Start of processing for Resolve_Call
begin
-- The context imposes a unique interpretation with type Typ on a
-- procedure or function call. Find the entity of the subprogram that
@ -5095,7 +5114,7 @@ package body Sem_Res is
-- Issue warning for possible infinite recursion in the absence
-- of the No_Recursion restriction.
if Nam = Scop
if Same_Or_Aliased_Subprograms (Nam, Scop)
and then not Restriction_Active (No_Recursion)
and then Check_Infinite_Recursion (N)
then
@ -5112,7 +5131,7 @@ package body Sem_Res is
else
Scope_Loop : while Scop /= Standard_Standard loop
if Nam = Scop then
if Same_Or_Aliased_Subprograms (Nam, Scop) then
-- Although in general case, recursion is not statically
-- checkable, the case of calling an immediately containing