2012-03-30 Robert Dewar <dewar@adacore.com>

	* exp_ch5.adb, sem_util.adb, exp_ch4.adb: Minor comment updates.

2012-03-30  Yannick Moy  <moy@adacore.com>

	* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@186006 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d3fb75a..34217e1 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2012-03-30  Robert Dewar  <dewar@adacore.com>
+
+       * exp_ch5.adb, sem_util.adb, exp_ch4.adb: Minor comment updates.
+
+2012-03-30  Yannick Moy  <moy@adacore.com>
+
+       * 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  <kirtchev@adacore.com>
 
        * 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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));