2012-04-02 Robert Dewar <dewar@adacore.com>

	* s-atopri.ads: Minor reformatting.

2012-04-02  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb: Minor reformatting, minor code cleanup.

2012-04-02  Ed Schonberg  <schonberg@adacore.com>

	* lib-xref.adb (Generate_Reference): For a reference to an
	operator symbol, set the sloc to point to the first character
	of the operator name, and not to the initial quaote.
	(Output_References): Ditto for the definition of an operator
	symbol.

2012-04-02  Vincent Celier  <celier@adacore.com>

	* ali.adb (Scan_Ali): Recognize Z lines. Set
	Implicit_With_From_Instantiation to True in the With_Record for
	Z lines.
	* ali.ads (With_Record): New Boolean component
	Implicit_With_From_Instantiation, defaulted to False.
	* csinfo.adb: Indicate that Implicit_With_From_Instantiation
	is special
	* lib-writ.adb (Write_ALI): New array Implicit_With.
	(Collect_Withs): Set Implicit_With for the unit is it is not Yes.
	(Write_With_Lines): Write a Z line instead of a W line if
	Implicit_With is Yes for the unit.
	* sem_ch12.adb (Inherit_Context): Only add a unit in the context
	if it is not there yet.
	* sinfo.ads: New flag Implicit_With_From_Instantiation (Flag12)
	added.



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

11 files changed, 161 insertions, 43 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 26f77b8e578..69c2a847d78 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,37 @@
+2012-04-02  Robert Dewar  <dewar@adacore.com>
+
+	* s-atopri.ads: Minor reformatting.
+
+2012-04-02  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_util.adb: Minor reformatting, minor code cleanup.
+
+2012-04-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* lib-xref.adb (Generate_Reference): For a reference to an
+	operator symbol, set the sloc to point to the first character
+	of the operator name, and not to the initial quaote.
+	(Output_References): Ditto for the definition of an operator
+	symbol.
+
+2012-04-02  Vincent Celier  <celier@adacore.com>
+
+	* ali.adb (Scan_Ali): Recognize Z lines. Set
+	Implicit_With_From_Instantiation to True in the With_Record for
+	Z lines.
+	* ali.ads (With_Record): New Boolean component
+	Implicit_With_From_Instantiation, defaulted to False.
+	* csinfo.adb: Indicate that Implicit_With_From_Instantiation
+	is special
+	* lib-writ.adb (Write_ALI): New array Implicit_With.
+	(Collect_Withs): Set Implicit_With for the unit is it is not Yes.
+	(Write_With_Lines): Write a Z line instead of a W line if
+	Implicit_With is Yes for the unit.
+	* sem_ch12.adb (Inherit_Context): Only add a unit in the context
+	if it is not there yet.
+	* sinfo.ads: New flag Implicit_With_From_Instantiation (Flag12)
+	added.
+
 2012-04-02  Yannick Moy  <moy@adacore.com>
 
 	* osint.adb, osint.ads (Add_Default_Search_Dirs): Add library
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 93dd10956cc..28307ac72a4 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -55,6 +55,7 @@ package body ALI is
       'X'    => True,   -- xref
       'S'    => True,   -- specific dispatching
       'Y'    => True,   -- limited_with
+      'Z'    => True,   -- implicit with from instantiation
       'C'    => True,   -- SCO information
       'F'    => True,   -- Alfa information
       others => False);
@@ -782,7 +783,8 @@ package body ALI is
       --  Acquire lines to be ignored
 
       if Read_Xref then
-         Ignore := ('U' | 'W' | 'Y' | 'D' | 'X' => False, others => True);
+         Ignore :=
+           ('U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True);
 
       --  Read_Lines parameter given
 
@@ -1717,7 +1719,7 @@ package body ALI is
 
          With_Loop : loop
             Check_Unknown_Line;
-            exit With_Loop when C /= 'W' and then C /= 'Y';
+            exit With_Loop when C /= 'W' and then C /= 'Y' and then C /= 'Z';
 
             if Ignore ('W') then
                Skip_Line;
@@ -1733,6 +1735,8 @@ package body ALI is
                Withs.Table (Withs.Last).Elab_All_Desirable := False;
                Withs.Table (Withs.Last).SAL_Interface      := False;
                Withs.Table (Withs.Last).Limited_With       := (C = 'Y');
+               Withs.Table (Withs.Last).Implicit_With_From_Instantiation
+                                                           := (C = 'Z');
 
                --  Generic case with no object file available
 
diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads
index b2b9b3d7ffc..39943c4fcc7 100644
--- a/gcc/ada/ali.ads
+++ b/gcc/ada/ali.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -558,6 +558,9 @@ package ALI is
 
       Limited_With : Boolean := False;
       --  True if unit is named in a limited_with_clause
+
+      Implicit_With_From_Instantiation : Boolean := False;
+      --  True if this is an implicit with from a generic instantiation
    end record;
 
    package Withs is new Table.Table (
diff --git a/gcc/ada/csinfo.adb b/gcc/ada/csinfo.adb
index ef319cff9e5..024af66479c 100644
--- a/gcc/ada/csinfo.adb
+++ b/gcc/ada/csinfo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -218,6 +218,7 @@ begin
    Set (Special, "Has_Dynamic_Range_Check",   True);
    Set (Special, "Has_Dynamic_Length_Check",  True);
    Set (Special, "Has_Private_View",          True);
+   Set (Special, "Implicit_With_From_Instantiation", True);
    Set (Special, "Is_Controlling_Actual",     True);
    Set (Special, "Is_Overloaded",             True);
    Set (Special, "Is_Static_Expression",      True);
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 2d67ea03ccd..e25355bfc30 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -196,6 +196,10 @@ package body Lib.Writ is
       Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
       --  Array of flags to show which units have Elaborate_All_Desirable set
 
+      type Yes_No is (Unknown, Yes, No);
+
+      Implicit_With : array (Units.First .. Last_Unit) of Yes_No;
+
       Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2));
       --  Sorted table of source dependencies. One extra entry in case we
       --  have to add a dummy entry for System.
@@ -276,6 +280,15 @@ package body Lib.Writ is
                else
                   Set_From_With_Type (Cunit_Entity (Unum));
                end if;
+
+               if Implicit_With (Unum) /= Yes then
+                  if Implicit_With_From_Instantiation (Item) then
+                     Implicit_With (Unum) := Yes;
+
+                  else
+                     Implicit_With (Unum) := No;
+                  end if;
+               end if;
             end if;
 
             Next (Item);
@@ -552,6 +565,7 @@ package body Lib.Writ is
             Elab_All_Flags     (J) := False;
             Elab_Des_Flags     (J) := False;
             Elab_All_Des_Flags (J) := False;
+            Implicit_With      (J) := Unknown;
          end loop;
 
          Collect_Withs (Unode);
@@ -770,10 +784,14 @@ package body Lib.Writ is
             Uname  := Units.Table (Unum).Unit_Name;
             Fname  := Units.Table (Unum).Unit_File_Name;
 
-            if Ekind (Cunit_Entity (Unum)) = E_Package
+            if Implicit_With (Unum) = Yes then
+               Write_Info_Initiate ('Z');
+
+            elsif Ekind (Cunit_Entity (Unum)) = E_Package
               and then From_With_Type (Cunit_Entity (Unum))
             then
                Write_Info_Initiate ('Y');
+
             else
                Write_Info_Initiate ('W');
             end if;
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index af5a69eec32..b6595b336a4 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1031,6 +1031,15 @@ package body Lib.Xref is
             Ref := Original_Location (Sloc (Nod));
             Def := Original_Location (Sloc (Ent));
 
+            --  If this is an operator symbol, skip the initial
+            --  quote, for navigation purposes.
+
+            if Nkind (N) = N_Defining_Operator_Symbol
+              or else Nkind (Nod) = N_Operator_Symbol
+            then
+               Ref := Ref + 1;
+            end if;
+
             Add_Entry
               ((Ent      => Ent,
                 Loc       => Ref,
@@ -1718,11 +1727,24 @@ package body Lib.Xref is
          --  since at the time the reference or definition is made, private
          --  types may be swapped, and the Sloc value may be incorrect. We
          --  also set up the pointer vector for the sort.
+         --  For user-defined operators we need to skip the initial
+         --  quote and point to the first character of the name, for
+         --  navigation purposes.
 
          for J in 1 .. Nrefs loop
-            Rnums (J) := J;
-            Xrefs.Table (J).Def :=
-              Original_Location (Sloc (Xrefs.Table (J).Key.Ent));
+            declare
+               E   : constant Entity_Id  := Xrefs.Table (J).Key.Ent;
+               Loc : constant Source_Ptr := Original_Location (Sloc (E));
+
+            begin
+               Rnums (J) := J;
+
+               if Nkind (E) = N_Defining_Operator_Symbol then
+                  Xrefs.Table (J).Def := Loc + 1;
+               else
+                  Xrefs.Table (J).Def := Loc;
+               end if;
+            end;
          end loop;
 
          --  Sort the references
diff --git a/gcc/ada/s-atopri.ads b/gcc/ada/s-atopri.ads
index 6f39cf0edb0..c8c75f2ff72 100644
--- a/gcc/ada/s-atopri.ads
+++ b/gcc/ada/s-atopri.ads
@@ -29,6 +29,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  ??? Need header saying what this unit is!!!
+
 package System.Atomic_Primitives is
    pragma Preelaborate;
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index e516ec0dc99..d0525633681 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -7761,6 +7761,9 @@ package body Sem_Ch12 is
       Item            : Node_Id;
       New_I           : Node_Id;
 
+      Clause : Node_Id;
+      OK     : Boolean;
+
    begin
       if Nkind (Parent (Gen_Decl)) = N_Compilation_Unit then
 
@@ -7782,17 +7785,30 @@ package body Sem_Ch12 is
          while Present (Item) loop
             if Nkind (Item) = N_With_Clause then
 
-               --  Take care to prevent direct cyclic with's, which can happen
-               --  if the generic body with's the current unit. Such a case
-               --  would result in binder errors (or run-time errors if the
-               --  -gnatE switch is in effect), but we want to prevent it here,
-               --  because Sem.Walk_Library_Items doesn't like cycles. Note
-               --  that we don't bother to detect indirect cycles.
+               --  Take care to prevent direct cyclic with's.
 
                if Library_Unit (Item) /= Current_Unit then
-                  New_I := New_Copy (Item);
-                  Set_Implicit_With (New_I, True);
-                  Append (New_I, Current_Context);
+                  --  Do not add a unit if it is already in the context
+
+                  Clause := First (Current_Context);
+                  OK := True;
+                  while Present (Clause) loop
+                     if Nkind (Clause) = N_With_Clause and then
+                       Chars (Name (Clause)) = Chars (Name (Item))
+                     then
+                        OK := False;
+                        exit;
+                     end if;
+
+                     Next (Clause);
+                  end loop;
+
+                  if OK then
+                     New_I := New_Copy (Item);
+                     Set_Implicit_With (New_I, True);
+                     Set_Implicit_With_From_Instantiation (New_I, True);
+                     Append (New_I, Current_Context);
+                  end if;
                end if;
             end if;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b8e4d813c08..b5255177b2c 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -752,11 +752,10 @@ package body Sem_Util is
 
       Bas := Base_Type (T);
 
-      --  If T is non-private but its base type is private, this is
-      --  the completion of a subtype declaration whose parent type
-      --  is private (see Complete_Private_Subtype in sem_ch3). The
-      --  proper discriminants are to be found in the full view of
-      --  the base.
+      --  If T is non-private but its base type is private, this is the
+      --  completion of a subtype declaration whose parent type is private
+      --  (see Complete_Private_Subtype in Sem_Ch3). The proper discriminants
+      --  are to be found in the full view of the base.
 
       if Is_Private_Type (Bas) and then Present (Full_View (Bas)) then
          Bas := Full_View (Bas);
@@ -783,10 +782,10 @@ package body Sem_Util is
          Decl :=
            Make_Subtype_Declaration (Loc,
              Defining_Identifier => Act,
-             Subtype_Indication =>
+             Subtype_Indication  =>
                Make_Subtype_Indication (Loc,
                  Subtype_Mark => New_Occurrence_Of (Bas, Loc),
-                 Constraint =>
+                 Constraint   =>
                    Make_Index_Or_Discriminant_Constraint (Loc,
                      Constraints => Constraints)));
 
@@ -813,8 +812,8 @@ package body Sem_Util is
       --  of the prefix.
 
       function Build_Discriminal_Record_Constraint return List_Id;
-      --  Similar to previous one, for discriminated components constrained
-      --  by the discriminant of the enclosing object.
+      --  Similar to previous one, for discriminated components constrained by
+      --  the discriminant of the enclosing object.
 
       ----------------------------------------
       -- Build_Discriminal_Array_Constraint --
@@ -970,12 +969,7 @@ package body Sem_Util is
       --  and thus will not have the unit name automatically prepended.
 
       Set_Package_Name (Spec_Id);
-
-      --  Append _E
-
-      Name_Buffer (Name_Len + 1) := '_';
-      Name_Buffer (Name_Len + 2) := 'E';
-      Name_Len := Name_Len + 2;
+      Add_Str_To_Name_Buffer ("_E");
 
       --  Create elaboration counter
 
@@ -1001,9 +995,9 @@ package body Sem_Util is
       Set_Current_Value    (Elab_Ent, Empty);
       Set_Last_Assignment  (Elab_Ent, Empty);
 
-      --  We do not want any further qualification of the name (if we did
-      --  not do this, we would pick up the name of the generic package
-      --  in the case of a library level generic instantiation).
+      --  We do not want any further qualification of the name (if we did not
+      --  do this, we would pick up the name of the generic package in the case
+      --  of a library level generic instantiation).
 
       Set_Has_Qualified_Name       (Elab_Ent);
       Set_Has_Fully_Qualified_Name (Elab_Ent);
@@ -1088,8 +1082,7 @@ package body Sem_Util is
                then
                   return False;
                else
-                  return
-                    Cannot_Raise_Constraint_Error (Expression (Expr));
+                  return Cannot_Raise_Constraint_Error (Expression (Expr));
                end if;
 
             when N_Unchecked_Type_Conversion =>
@@ -1099,8 +1092,7 @@ package body Sem_Util is
                if Do_Overflow_Check (Expr) then
                   return False;
                else
-                  return
-                    Cannot_Raise_Constraint_Error (Right_Opnd (Expr));
+                  return Cannot_Raise_Constraint_Error (Right_Opnd (Expr));
                end if;
 
             when N_Op_Divide |
@@ -1157,8 +1149,7 @@ package body Sem_Util is
    -- Check_Implicit_Dereference --
    --------------------------------
 
-   procedure Check_Implicit_Dereference (Nam : Node_Id;  Typ : Entity_Id)
-   is
+   procedure Check_Implicit_Dereference (Nam : Node_Id;  Typ : Entity_Id) is
       Disc  : Entity_Id;
       Desig : Entity_Id;
 
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index a8388b19344..a89f9b26269 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1624,6 +1624,14 @@ package body Sinfo is
       return Flag16 (N);
    end Implicit_With;
 
+   function Implicit_With_From_Instantiation
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_With_Clause);
+      return Flag12 (N);
+   end Implicit_With_From_Instantiation;
+
    function Interface_List
       (N : Node_Id) return List_Id is
    begin
@@ -4704,6 +4712,14 @@ package body Sinfo is
       Set_Flag16 (N, Val);
    end Set_Implicit_With;
 
+   procedure Set_Implicit_With_From_Instantiation
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_With_Clause);
+      Set_Flag12 (N, Val);
+   end Set_Implicit_With_From_Instantiation;
+
    procedure Set_Interface_List
       (N : Node_Id; Val : List_Id) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index e9f1c8ef684..fa7dbee35aa 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1226,6 +1226,9 @@ package Sinfo is
    --    'Address or 'Tag attribute. ???There are other implicit with clauses
    --    as well.
 
+   --  Implicit_With_From_Instantiation (Flag12-Sem)
+   --     Set in N_With_Clause nodes from generic instantiations.
+
    --  Import_Interface_Present (Flag16-Sem)
    --     This flag is set in an Interface or Import pragma if a matching
    --     pragma of the other kind is also present. This is used to avoid
@@ -5805,6 +5808,7 @@ package Sinfo is
       --  Elaborate_Desirable (Flag11-Sem)
       --  Private_Present (Flag15) set if with_clause has private keyword
       --  Implicit_With (Flag16-Sem)
+      --  Implicit_With_From_Instantiation (Flag12-Sem)
       --  Limited_Present (Flag17) set if LIMITED is present
       --  Limited_View_Installed (Flag18-Sem)
       --  Unreferenced_In_Spec (Flag7-Sem)
@@ -8592,6 +8596,9 @@ package Sinfo is
    function Implicit_With
      (N : Node_Id) return Boolean;    -- Flag16
 
+   function Implicit_With_From_Instantiation
+     (N : Node_Id) return Boolean;    -- Flag12
+
    function Import_Interface_Present
      (N : Node_Id) return Boolean;    -- Flag16
 
@@ -9573,6 +9580,9 @@ package Sinfo is
    procedure Set_Implicit_With
      (N : Node_Id; Val : Boolean := True);    -- Flag16
 
+   procedure Set_Implicit_With_From_Instantiation
+     (N : Node_Id; Val : Boolean := True);    -- Flag12
+
    procedure Set_Import_Interface_Present
      (N : Node_Id; Val : Boolean := True);    -- Flag16
 
@@ -11959,6 +11969,7 @@ package Sinfo is
    pragma Inline (High_Bound);
    pragma Inline (Identifier);
    pragma Inline (Implicit_With);
+   pragma Inline (Implicit_With_From_Instantiation);
    pragma Inline (Interface_List);
    pragma Inline (Interface_Present);
    pragma Inline (Includes_Infinities);