[Ada] Reflect ACT changes of 2001-11-04
Geert Bosch
bosch@darwin.gnat.com
Mon Dec 17 13:04:00 GMT 2001
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.
*** ali.adb 2001/11/02 13:33:17 1.129
--- ali.adb 2001/11/04 16:07:19 1.130
***************
*** 1332,1338 ****
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;
--- 1332,1337 ----
*** ali.adb 2001/11/04 16:07:19 1.130
--- ali.adb 2001/11/04 16:23:49 1.131
***************
*** 134,140 ****
-- 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.
function Get_Nat return Nat;
-- Skip blanks, then scan out an unsigned integer value in Nat range
--- 134,140 ----
-- 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 or '='.
function Get_Nat return Nat;
-- Skip blanks, then scan out an unsigned integer value in Nat range
***************
*** 305,312 ****
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 = '>';
end loop;
-- Convert file name to all lower case if file names are not case
--- 305,315 ----
loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Getc;
! 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,1312 ****
--- 1308,1336 ----
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;
***************
*** 1346,1351 ****
--- 1370,1376 ----
end if;
P := P + 1; -- skip closing bracket
+ Skip_Space;
-- No typeref entry present
*** ali.ads 2001/11/02 13:33:22 1.75
--- ali.ads 2001/11/04 16:23:57 1.76
***************
*** 616,621 ****
--- 616,629 ----
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.
*** lib-xref.ads 2001/11/02 13:33:14 1.33
--- lib-xref.ads 2001/11/04 16:24:01 1.34
***************
*** 56,62 ****
--
-- The lines following the header look like
--
! -- line type col level entity typeref ref ref ref
--
-- line is the line number of the referenced entity. It starts
-- in column one.
--- 56,62 ----
--
-- The lines following the header look like
--
! -- 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,81 ****
--
-- entity is the name of the referenced entity, with casing in
-- the canical casing for the source file where it is defined.
--
! -- typeref is the reference for the 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=()
--- 73,96 ----
--
-- 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 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,103 ****
-- 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:
--
! -- 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.
--
-- There may be zero or more ref entries on each line
--
--- 99,118 ----
-- 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:
--
! -- 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 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,211 ****
--
-- a reference on line 11, column 56 of unit number 3
--
! -- 2U13 p3 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:
--
-- the corresponding body entity at line 5, column 13,
-- of the current file.
--- 216,227 ----
--
-- a reference on line 11, column 56 of unit number 3
--
! -- 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. 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.
*** lib-xref.adb 2001/11/02 13:33:10 1.60
--- lib-xref.adb 2001/11/04 16:24:06 1.61
***************
*** 449,454 ****
--- 449,457 ----
Tref : Entity_Id;
-- Type reference
+ Rref : Node_Id;
+ -- Renaming reference
+
Trunit : Unit_Number_Type;
-- Unit number for type reference
***************
*** 729,736 ****
Write_Info_Char (Cursrc (J));
end loop;
end if;
! -- Output type reference if any
Tref := XE.Ent;
Left := '{';
--- 732,783 ----
Write_Info_Char (Cursrc (J));
end loop;
end if;
+
+ -- 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,812 ****
--- 854,861 ----
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
***************
*** 862,867 ****
--- 911,918 ----
null;
end if;
end loop;
+
+ -- End of processing for entity output
Curru := Curxu;
Crloc := No_Location;
*** checks.adb 2001/10/28 15:12:48 1.209
--- checks.adb 2001/11/04 17:18:42 1.210
***************
*** 1958,1976 ****
Lo : out Uint;
Hi : out Uint)
is
! Typ : constant Entity_Id := Etype (N);
! 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;
function OK_Operands return Boolean;
-- Used for binary operators. Determines the ranges of the left and
-- right operands, and if they are both OK, returns True, and puts
--- 1958,1989 ----
Lo : out Uint;
Hi : out Uint)
is
! Typ : constant Entity_Id := Etype (N);
! Lo_Left : Uint;
! Hi_Left : Uint;
! -- Lo and Hi bounds of left operand
!
Lo_Right : Uint;
Hi_Right : Uint;
! -- 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
-- right operands, and if they are both OK, returns True, and puts
***************
*** 2042,2049 ****
-- 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
Bound := Type_Low_Bound (Typ);
if Compile_Time_Known_Value (Bound) then
--- 2055,2066 ----
-- 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 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);
if Compile_Time_Known_Value (Bound) then
***************
*** 2057,2074 ****
return;
end if;
Bound := Type_High_Bound (Typ);
! if Compile_Time_Known_Value (Bound) then
! Hi := Expr_Value (Bound);
! elsif Compile_Time_Known_Value (Type_High_Bound (Base_Type (Typ))) then
Hbound := Expr_Value (Type_High_Bound (Base_Type (Typ)));
Hi := Hbound;
else
OK := False;
return;
end if;
-- We may be able to refine this value in certain situations. If
--- 2074,2101 ----
return;
end if;
+ -- Now the high bound
+
Bound := Type_High_Bound (Typ);
! -- 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.
! if Compile_Time_Known_Value (Type_High_Bound (Base_Type (Typ))) then
Hbound := Expr_Value (Type_High_Bound (Base_Type (Typ)));
Hi := Hbound;
else
OK := False;
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
*** g-socket.ads 2001/10/29 02:06:14 1.23
--- g-socket.ads 2001/11/04 20:23:10 1.24
***************
*** 622,628 ****
procedure Close_Socket (Socket : Socket_Type);
-- Close a socket and more specifically a non-connected socket.
- -- Fail silently.
procedure Connect_Socket
(Socket : Socket_Type;
--- 622,627 ----
***************
*** 718,724 ****
-- 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.
type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
-- Same interface as Ada.Streams.Stream_IO
--- 717,723 ----
-- 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.
type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
-- Same interface as Ada.Streams.Stream_IO
More information about the Gcc-patches
mailing list