Skip to content

R
riscv-gcc-1
Commit c1c22e7a by Geert Bosch
Options

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
parent 7eb7bb07
Showing with 193 additions and 40 deletions
gcc/ada/ChangeLog
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.
......
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
......
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.
......
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.
......
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
......
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;
......
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.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment