ali.adb: Type reference does not reset current file.

	* ali.adb: Type reference does not reset current file.

	* ali.adb: Recognize and scan renaming reference

	* ali.ads: Add spec for storing renaming references.

	* lib-xref.ads: Add documentation for handling of renaming references

	* lib-xref.adb: Implement output of renaming reference.

	* checks.adb:
	(Determine_Range): Document local variables
	(Determine_Range): Make sure Hbound is initialized. It looks as though
	 there could be a real problem here with an uninitialized reference
	 to Hbound, but no actual example of failure has been found.

	* g-socket.ads:
	Fix comment of Shutdown_Socket and Close_Socket. These functions
	should not fail silently because if they are called twice, this
	probably means that there is a race condition in the user program.
	Anyway, this behaviour is consistent with the rest of this unit.
	When an error occurs, an exception is raised with the error message
	as exception message.

From-SVN: r48125

7 files changed, 193 insertions, 40 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 01209795..2c049d9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,33 @@
 2001-12-17  Robert Dewar <dewar@gnat.com>
 
+	* ali.adb: Type reference does not reset current file.
+	
+	* ali.adb: Recognize and scan renaming reference
+	
+	* ali.ads: Add spec for storing renaming references.
+	
+	* lib-xref.ads: Add documentation for handling of renaming references
+	
+	* lib-xref.adb: Implement output of renaming reference.
+	
+	* checks.adb:
+	(Determine_Range): Document local variables
+	(Determine_Range): Make sure Hbound is initialized. It looks as though
+	 there could be a real problem here with an uninitialized reference
+	 to Hbound, but no actual example of failure has been found.
+	
+2001-12-17  Laurent Pautet <pautet@gnat.com>
+
+	* g-socket.ads:
+	Fix comment of Shutdown_Socket and Close_Socket. These functions
+	should not fail silently because if they are called twice, this
+	probably means that there is a race condition in the user program.
+	Anyway, this behaviour is consistent with the rest of this unit.
+	When an error occurs, an exception is raised with the error message
+	as exception message.
+
+2001-12-17  Robert Dewar <dewar@gnat.com>
+
 	* frontend.adb: Move call to Check_Unused_Withs from Frontend, so 
 	that it happens before modification of Sloc values for -gnatD.
 	
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 8ce631e..c0d744f 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -134,7 +134,7 @@ package body ALI is
       --  all lower case. This only happends for systems where file names are
       --  not case sensitive, and ensures that gnatbind works correctly on
       --  such systems, regardless of the case of the file name. Note that
-      --  a name can be terminated by a right typeref bracket.
+      --  a name can be terminated by a right typeref bracket or '='.
 
       function Get_Nat return Nat;
       --  Skip blanks, then scan out an unsigned integer value in Nat range
@@ -305,8 +305,11 @@ package body ALI is
          loop
             Name_Len := Name_Len + 1;
             Name_Buffer (Name_Len) := Getc;
-            exit when At_End_Of_Field;
-            exit when Nextc = ')' or else Nextc = '}' or else Nextc = '>';
+            exit when At_End_Of_Field
+              or else Nextc = ')'
+              or else Nextc = '}'
+              or else Nextc = '>'
+              or else Nextc = '=';
          end loop;
 
          --  Convert file name to all lower case if file names are not case
@@ -1305,8 +1308,29 @@ package body ALI is
                   XE.Lib    := (Getc = '*');
                   XE.Entity := Get_Name;
 
+                  --  Renaming reference is present
+
+                  if Nextc = '=' then
+                     P := P + 1;
+                     XE.Rref_Line := Get_Nat;
+
+                     if Getc /= ':' then
+                        Fatal_Error;
+                     end if;
+
+                     XE.Rref_Col := Get_Nat;
+
+                  --  No renaming reference present
+
+                  else
+                     XE.Rref_Line := 0;
+                     XE.Rref_Col  := 0;
+                  end if;
+
                   Skip_Space;
 
+                  --  See if type reference present
+
                   case Nextc is
                      when '<'    => XE.Tref := Tref_Derived;
                      when '('    => XE.Tref := Tref_Access;
@@ -1332,7 +1356,6 @@ package body ALI is
                         if Nextc = '|' then
                            XE.Tref_File_Num :=
                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
-                           Current_File_Num := XE.Tref_File_Num;
                            P := P + 1;
                            N := Get_Nat;
 
@@ -1347,6 +1370,7 @@ package body ALI is
                      end if;
 
                      P := P + 1; -- skip closing bracket
+                     Skip_Space;
 
                   --  No typeref entry present
 
diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads
index af88530..1e427e8 100644
--- a/gcc/ada/ali.ads
+++ b/gcc/ada/ali.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                            $Revision: 1.3 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
 --                                                                          --
@@ -616,6 +616,14 @@ package ALI is
       Entity : Name_Id;
       --  Name of entity
 
+      Rref_Line : Nat;
+      --  This field is set to the line number of a renaming reference if
+      --  one is present, or to zero if no renaming reference is present
+
+      Rref_Col : Nat;
+      --  This field is set to the column number of a renaming reference
+      --  if one is present, or to zero if no renaming reference is present.
+
       Tref : Tref_Kind;
       --  Indicates if a typeref is present, and if so what kind. Set to
       --  Tref_None if no typeref field is present.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 896481e..6f0c879 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -1958,18 +1958,31 @@ package body Checks is
       Lo : out Uint;
       Hi : out Uint)
    is
-      Typ  : constant Entity_Id := Etype (N);
+      Typ : constant Entity_Id := Etype (N);
+
+      Lo_Left : Uint;
+      Hi_Left : Uint;
+      --  Lo and Hi bounds of left operand
 
-      Lo_Left  : Uint;
       Lo_Right : Uint;
-      Hi_Left  : Uint;
       Hi_Right : Uint;
-      Bound    : Node_Id;
-      Hbound   : Uint;
-      Lor      : Uint;
-      Hir      : Uint;
-      OK1      : Boolean;
-      Cindex   : Cache_Index;
+      --  Lo and Hi bounds of right (or only) operand
+
+      Bound : Node_Id;
+      --  Temp variable used to hold a bound node
+
+      Hbound : Uint;
+      --  High bound of base type of expression
+
+      Lor : Uint;
+      Hir : Uint;
+      --  Refined values for low and high bounds, after tightening
+
+      OK1 : Boolean;
+      --  Used in lower level calls to indicate if call succeeded
+
+      Cindex : Cache_Index;
+      --  Used to search cache
 
       function OK_Operands return Boolean;
       --  Used for binary operators. Determines the ranges of the left and
@@ -2042,7 +2055,11 @@ package body Checks is
 
       --  We use the actual bound unless it is dynamic, in which case
       --  use the corresponding base type bound if possible. If we can't
-      --  get a bound then
+      --  get a bound then we figure we can't determine the range (a
+      --  peculiar case, that perhaps cannot happen, but there is no
+      --  point in bombing in this optimization circuit.
+
+      --  First the low bound
 
       Bound := Type_Low_Bound (Typ);
 
@@ -2057,12 +2074,15 @@ package body Checks is
          return;
       end if;
 
+      --  Now the high bound
+
       Bound := Type_High_Bound (Typ);
 
-      if Compile_Time_Known_Value (Bound) then
-         Hi := Expr_Value (Bound);
+      --  We need the high bound of the base type later on, and this should
+      --  always be compile time known. Again, it is not clear that this
+      --  can ever be false, but no point in bombing.
 
-      elsif Compile_Time_Known_Value (Type_High_Bound (Base_Type (Typ))) then
+      if Compile_Time_Known_Value (Type_High_Bound (Base_Type (Typ))) then
          Hbound := Expr_Value (Type_High_Bound (Base_Type (Typ)));
          Hi := Hbound;
 
@@ -2071,6 +2091,13 @@ package body Checks is
          return;
       end if;
 
+      --  If we have a static subtype, then that may have a tighter bound
+      --  so use the upper bound of the subtype instead in this case.
+
+      if Compile_Time_Known_Value (Bound) then
+         Hi := Expr_Value (Bound);
+      end if;
+
       --  We may be able to refine this value in certain situations. If
       --  refinement is possible, then Lor and Hir are set to possibly
       --  tighter bounds, and OK1 is set to True.
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index 4837ece..2ed95ed 100644
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                            $Revision: 1.1 $
+--                            $Revision$
 --                                                                          --
 --              Copyright (C) 2001 Ada Core Technologies, Inc.              --
 --                                                                          --
@@ -622,7 +622,6 @@ package GNAT.Sockets is
 
    procedure Close_Socket (Socket : Socket_Type);
    --  Close a socket and more specifically a non-connected socket.
-   --  Fail silently.
 
    procedure Connect_Socket
      (Socket : Socket_Type;
@@ -718,7 +717,7 @@ package GNAT.Sockets is
    --  Shutdown a connected socket. If How is Shut_Read, further
    --  receives will be disallowed. If How is Shut_Write, further
    --  sends will be disallowed. If how is Shut_Read_Write, further
-   --  sends and receives will be disallowed. Fail silently.
+   --  sends and receives will be disallowed.
 
    type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
    --  Same interface as Ada.Streams.Stream_IO
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index 931e02f..06397c7 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -449,6 +449,9 @@ package body Lib.Xref is
          Tref : Entity_Id;
          --  Type reference
 
+         Rref : Node_Id;
+         --  Renaming reference
+
          Trunit : Unit_Number_Type;
          --  Unit number for type reference
 
@@ -730,7 +733,51 @@ package body Lib.Xref is
                         end loop;
                      end if;
 
-                     --  Output type reference if any
+                     --  See if we have a renaming reference
+
+                     if Is_Object (XE.Ent)
+                       and then Present (Renamed_Object (XE.Ent))
+                     then
+                        Rref := Renamed_Object (XE.Ent);
+
+                     elsif Is_Overloadable (XE.Ent)
+                       and then Nkind (Parent (Declaration_Node (XE.Ent))) =
+                                            N_Subprogram_Renaming_Declaration
+                     then
+                        Rref := Name (Parent (Declaration_Node (XE.Ent)));
+
+                     elsif Ekind (XE.Ent) = E_Package
+                       and then Nkind (Declaration_Node (XE.Ent)) =
+                                         N_Package_Renaming_Declaration
+                     then
+                        Rref := Name (Declaration_Node (XE.Ent));
+
+                     else
+                        Rref := Empty;
+                     end if;
+
+                     if Present (Rref) then
+                        if Nkind (Rref) = N_Expanded_Name then
+                           Rref := Selector_Name (Rref);
+                        end if;
+
+                        if Nkind (Rref) /= N_Identifier then
+                           Rref := Empty;
+                        end if;
+                     end if;
+
+                     --  Write out renaming reference if we have one
+
+                     if Debug_Flag_MM and then Present (Rref) then
+                        Write_Info_Char ('=');
+                        Write_Info_Nat
+                          (Int (Get_Logical_Line_Number (Sloc (Rref))));
+                        Write_Info_Char (':');
+                        Write_Info_Nat
+                          (Int (Get_Column_Number (Sloc (Rref))));
+                     end if;
+
+                     --  See if we have a type reference
 
                      Tref := XE.Ent;
                      Left := '{';
@@ -807,6 +854,8 @@ package body Lib.Xref is
 
                         exit when No (Tref) or else Tref = Sav;
 
+                        --  Here we have a type reference to output
+
                         --  Case of standard entity, output name
 
                         if Sloc (Tref) = Standard_Location then
@@ -863,6 +912,8 @@ package body Lib.Xref is
                         end if;
                      end loop;
 
+                     --  End of processing for entity output
+
                      Curru := Curxu;
                      Crloc := No_Location;
                   end if;
diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads
index 2d5566c..396d846 100644
--- a/gcc/ada/lib-xref.ads
+++ b/gcc/ada/lib-xref.ads
@@ -56,7 +56,7 @@ package Lib.Xref is
    --
    --  The lines following the header look like
    --
-   --     line type col level  entity typeref  ref  ref  ref
+   --     line type col level entity renameref typeref ref  ref  ref
    --
    --        line is the line number of the referenced entity. It starts
    --        in column one.
@@ -73,9 +73,24 @@ package Lib.Xref is
    --
    --        entity is the name of the referenced entity, with casing in
    --        the canical casing for the source file where it is defined.
+
+   --        renameref provides information on renaming. If the entity is
+   --        a package, object or overloadable entity which is declared by
+   --        a renaming declaration, and the renaming refers to an entity
+   --        with a simple identifier or expanded name, then renameref has
+   --        the form:
+   --
+   --            =line:col
+   --
+   --        Here line:col give the reference to the identifier that
+   --        appears in the renaming declaration. Note that we never need
+   --        a file entry, since this identifier is always in the current
+   --        file in which the entity is declared. Currently, renameref
+   --        appears only for the simple renaming case. If the renaming
+   --        reference is a complex expressions, then renameref is omitted.
    --
-   --        typeref is the reference for the type. This part is optional.
-   --        It is present for the following cases:
+   --        typeref is the reference for a related type. This part is
+   --        optional. It is present for the following cases:
    --
    --          derived types (points to the parent type)   LR=<>
    --          access types (points to designated type)    LR=()
@@ -84,20 +99,20 @@ package Lib.Xref is
    --          enumeration literals (points to enum type)  LR={}
    --          objects and components (points to type)     LR={}
    --
-   --        In the above list LR shows the brackets used in the output,
-   --        which has one of the two following forms:
+   --          In the above list LR shows the brackets used in the output,
+   --          which has one of the two following forms:
    --
-   --          L file | line type col R      user entity
-   --          L name-in-lower-case   R      standard entity
+   --            L file | line type col R      user entity
+   --            L name-in-lower-case   R      standard entity
    --
-   --        For the form for a user entity, file is the dependency number
-   --        of the file containing the declaration of the parent type. This
-   --        number and the following vertical bar are omitted if the relevant
-   --        type is defined in the same file as the current entity. The line,
-   --        type, col are defined as previously described, and specify the
-   --        location of the relevant type declaration in the referenced file.
-   --        For the standard entity form, the name between the brackets is
-   --        the normal name of the entity in lower case letters.
+   --          For the form for a user entity, file is the dependency number
+   --          of the file containing the declaration of the related type.
+   --          This number and the following vertical bar are omitted if the
+   --          relevant type is defined in the same file as the current entity.
+   --          The line, type, col are defined as previously described, and
+   --          specify the location of the relevant type declaration in the
+   --          referenced file. For the standard entity form, the name between
+   --          the brackets is the normal name of the entity in lower case.
    --
    --     There may be zero or more ref entries on each line
    --
@@ -201,11 +216,12 @@ package Lib.Xref is
    --
    --              a reference on line 11, column 56 of unit number 3
    --
-   --        2U13 p3 5b13 8r4 12r13 12t15
+   --        2U13 p3=2:35 5b13 8r4 12r13 12t15
    --
    --           This line gives references for the non-publicly visible
-   --           procedure p3 declared on line 2, column 13. There are
-   --           four references:
+   --           procedure p3 declared on line 2, column 13. This procedure
+   --           renames the procedure whose identifier reference is at
+   --           line 2 column 35. There are four references:
    --
    --              the corresponding body entity at line 5, column 13,
    --              of the current file.