From 4b985e20549b2d093ea64b2e4cf63cada964fac1 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 30 Mar 2012 11:32:55 +0200 Subject: [PATCH] [multiple changes] 2012-03-30 Robert Dewar * exp_ch5.adb, sem_util.adb, exp_ch4.adb: Minor comment updates. 2012-03-30 Yannick Moy * lib-xref-alfa.adb (Add_Alfa_File): Treat possibly 2 units at the same time, putting all scopes in the same Alfa file. (Add_Alfa_Xrefs): Correct errors in comparison function. Correct value of Def component. (Collect_Alfa): Possibly pass 2 units to Add_Alfa_File. From-SVN: r186006 --- gcc/ada/ChangeLog | 12 +++++++ gcc/ada/exp_ch4.adb | 10 +++--- gcc/ada/exp_ch5.adb | 2 +- gcc/ada/lib-xref-alfa.adb | 83 ++++++++++++++++++++++++++++++++++++++--------- gcc/ada/sem_util.adb | 1 - 5 files changed, 86 insertions(+), 22 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d3fb75a..34217e1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2012-03-30 Robert Dewar + + * exp_ch5.adb, sem_util.adb, exp_ch4.adb: Minor comment updates. + +2012-03-30 Yannick Moy + + * lib-xref-alfa.adb (Add_Alfa_File): Treat possibly 2 units at the same + time, putting all scopes in the same Alfa file. + (Add_Alfa_Xrefs): Correct errors in comparison function. Correct value + of Def component. + (Collect_Alfa): Possibly pass 2 units to Add_Alfa_File. + 2012-03-30 Hristian Kirtchev * exp_util.adb (Is_Secondary_Stack_BIP_Func_Call): Handle a case where diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d04512a..09949a1 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3072,7 +3072,7 @@ package body Exp_Ch4 is Low_Bound := Opnd_Low_Bound (1); -- OK, we don't know the lower bound, we have to build a horrible - -- expression actions node of the form + -- conditional expression node of the form -- if Cond1'Length /= 0 then -- Opnd1 low bound @@ -3998,9 +3998,9 @@ package body Exp_Ch4 is end if; end; - -- We set the allocator as analyzed so that when we analyze the - -- expression actions node, we do not get an unwanted recursive - -- expansion of the allocator expression. + -- We set the allocator as analyzed so that when we analyze + -- the conditional expression node, we do not get an unwanted + -- recursive expansion of the allocator expression. Set_Analyzed (N, True); Nod := Relocate_Node (N); @@ -4279,7 +4279,7 @@ package body Exp_Ch4 is -- Expand_N_Conditional_Expression -- ------------------------------------- - -- Deal with limited types and expression actions + -- Deal with limited types and condition actions procedure Expand_N_Conditional_Expression (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 3497456..82fc705 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2777,7 +2777,7 @@ package body Exp_Ch5 is end loop; -- Loop through elsif parts, dealing with constant conditions and - -- possible expression actions that are present. + -- possible condition actions that are present. if Present (Elsif_Parts (N)) then E := First (Elsif_Parts (N)); diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index 7ccacbb..e63863c 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -85,9 +85,12 @@ package body Alfa is -- Local Subprograms -- ----------------------- - procedure Add_Alfa_File (U : Unit_Number_Type; D : Nat); - -- Add file U and all scopes in U to the tables Alfa_File_Table and - -- Alfa_Scope_Table. + procedure Add_Alfa_File (Ubody, Uspec : Unit_Number_Type; Dspec : Nat); + -- Add file and corresponding scopes for unit to the tables Alfa_File_Table + -- and Alfa_Scope_Table. When two units are present for the same + -- compilation unit, as it happens for library-level instantiations of + -- generics, then Ubody /= Uspec, and all scopes are added to the same + -- Alfa file. Otherwise Ubody = Uspec. procedure Add_Alfa_Scope (N : Node_Id); -- Add scope N to the table Alfa_Scope_Table @@ -128,8 +131,8 @@ package body Alfa is -- Add_Alfa_File -- ------------------- - procedure Add_Alfa_File (U : Unit_Number_Type; D : Nat) is - File : constant Source_File_Index := Source_Index (U); + procedure Add_Alfa_File (Ubody, Uspec : Unit_Number_Type; Dspec : Nat) is + File : constant Source_File_Index := Source_Index (Uspec); From : Scope_Index; File_Name : String_Ptr; @@ -145,16 +148,29 @@ package body Alfa is From := Alfa_Scope_Table.Last + 1; - -- Unit U might not have an associated compilation unit, as seen in code + -- Unit might not have an associated compilation unit, as seen in code -- filling Sdep_Table in Write_ALI. - if Present (Cunit (U)) then + if Present (Cunit (Ubody)) then Traverse_Compilation_Unit - (CU => Cunit (U), + (CU => Cunit (Ubody), Process => Detect_And_Add_Alfa_Scope'Access, Inside_Stubs => False); end if; + -- When two units are present for the same compilation unit, as it + -- happens for library-level instantiations of generics, then add all + -- scopes to the same Alfa file. + + if Ubody /= Uspec then + if Present (Cunit (Uspec)) then + Traverse_Compilation_Unit + (CU => Cunit (Uspec), + Process => Detect_And_Add_Alfa_Scope'Access, + Inside_Stubs => False); + end if; + end if; + -- Update scope numbers declare @@ -166,7 +182,7 @@ package body Alfa is S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Index); begin S.Scope_Num := Scope_Id; - S.File_Num := D; + S.File_Num := Dspec; Scope_Id := Scope_Id + 1; end; end loop; @@ -199,9 +215,9 @@ package body Alfa is File_Name := new String'(Name_Buffer (1 .. Name_Len)); -- For subunits, also retrieve the file name of the unit. Only do so if - -- unit U has an associated compilation unit. + -- unit has an associated compilation unit. - if Present (Cunit (U)) + if Present (Cunit (Uspec)) and then Present (Cunit (Unit (File))) and then Nkind (Unit (Cunit (Unit (File)))) = N_Subunit then @@ -212,7 +228,7 @@ package body Alfa is Alfa_File_Table.Append ( (File_Name => File_Name, Unit_File_Name => Unit_File_Name, - File_Num => D, + File_Num => Dspec, From_Scope => From, To_Scope => Alfa_Scope_Table.Last)); end Add_Alfa_File; @@ -554,6 +570,13 @@ package body Alfa is elsif T1.Def /= T2.Def then return T1.Def < T2.Def; + -- The following should be commented, it sure looks like a test, + -- but it sits uncommented between the "third test" and the "fourth + -- test! ??? Shouldn't this in any case be an assertion ??? + + elsif T1.Key.Ent /= T2.Key.Ent then + raise Program_Error; + -- Fourth test: if reference is in same unit as entity definition, -- sort first. @@ -576,7 +599,7 @@ package body Alfa is then return True; - elsif T1.Ent_Scope_File = T1.Key.Lun + elsif T2.Ent_Scope_File = T2.Key.Lun and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope and then T2.Key.Ent_Scope = T2.Key.Ref_Scope then @@ -679,6 +702,13 @@ package body Alfa is Rnums (Nrefs) := Xrefs.Last; end loop; + -- Capture the definition Sloc values. As in the case of normal cross + -- references, we have to wait until now to get the correct value. + + for Index in 1 .. Nrefs loop + Xrefs.Table (Index).Def := Sloc (Xrefs.Table (Index).Key.Ent); + end loop; + -- Eliminate entries not appropriate for Alfa. Done prior to sorting -- cross-references, as it discards useless references which do not have -- a proper format for the comparison function (like no location). @@ -839,6 +869,9 @@ package body Alfa is ------------------ procedure Collect_Alfa (Sdep_Table : Unit_Ref_Table; Num_Sdep : Nat) is + D1 : Nat; + D2 : Nat; + begin -- Cross-references should have been computed first @@ -848,8 +881,28 @@ package body Alfa is -- Generate file and scope Alfa information - for D in 1 .. Num_Sdep loop - Add_Alfa_File (U => Sdep_Table (D), D => D); + D1 := 1; + while D1 <= Num_Sdep loop + + -- In rare cases, when treating the library-level instantiation of a + -- generic, two consecutive units refer to the same compilation unit + -- node and entity. In that case, treat them as a single unit for the + -- sake of Alfa cross references by passing to Add_Alfa_File. + + if D1 < Num_Sdep + and then Cunit_Entity (Sdep_Table (D1)) = + Cunit_Entity (Sdep_Table (D1 + 1)) + then + D2 := D1 + 1; + else + D2 := D1; + end if; + + Add_Alfa_File + (Ubody => Sdep_Table (D1), + Uspec => Sdep_Table (D2), + Dspec => D2); + D1 := D2 + 1; end loop; -- Fill in the spec information when relevant diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 6519221..50200e7 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8674,7 +8674,6 @@ package body Sem_Util is -- only affects the generation of internal expanded code, since -- calls to instantiations of Unchecked_Conversion are never -- considered variables (since they are function calls). - -- This is also true for expression actions. when N_Unchecked_Type_Conversion => return Is_Variable (Expression (Orig_Node)); -- 2.7.4