From ee81cbe97718536484b0b623ff875d4a3fabbce0 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 14 Jun 2010 14:46:56 +0200 Subject: [PATCH] [multiple changes] 2010-06-14 Pascal Obry * s-finimp.adb: Fix typo. * raise.h: Remove duplicate blank line. 2010-06-14 Vincent Celier * 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 * 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 --- gcc/ada/ChangeLog | 20 +++++++++++++++++++ gcc/ada/prj-nmsc.adb | 47 +++++++++++++++++++++++++++++++++++++++----- gcc/ada/raise.h | 1 - gcc/ada/s-finimp.adb | 4 ++-- gcc/ada/sem_res.adb | 23 ++++++++++++++++++++-- 5 files changed, 85 insertions(+), 10 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 484541e9d6e..434bdb79178 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2010-06-14 Pascal Obry + + * s-finimp.adb: Fix typo. + * raise.h: Remove duplicate blank line. + +2010-06-14 Vincent Celier + + * 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 + + * 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 * sem_ch8.adb (End_Use_Type): Before indicating that an operator is not diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index ca6a732ac76..7dc8ad3250f 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -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; diff --git a/gcc/ada/raise.h b/gcc/ada/raise.h index b0de4912f30..1321518ee7b 100644 --- a/gcc/ada/raise.h +++ b/gcc/ada/raise.h @@ -29,7 +29,6 @@ * * ****************************************************************************/ - /* C counterparts of what System.Standard_Library defines. */ typedef unsigned Exception_Code; diff --git a/gcc/ada/s-finimp.adb b/gcc/ada/s-finimp.adb index 9a5e534b4d4..050f79995ec 100644 --- a/gcc/ada/s-finimp.adb +++ b/gcc/ada/s-finimp.adb @@ -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); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 9a0a0acf365..14c02100e93 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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 -- 2.30.2