* 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
+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
-- 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
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
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;
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;
end if;
P := P + 1; -- skip closing bracket
+ Skip_Space;
-- No typeref entry present
-- --
-- S p e c --
-- --
--- $Revision: 1.3 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
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.
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
-- 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);
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;
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.
-- --
-- S p e c --
-- --
--- $Revision: 1.1 $
+-- $Revision$
-- --
-- Copyright (C) 2001 Ada Core Technologies, Inc. --
-- --
procedure Close_Socket (Socket : Socket_Type);
-- Close a socket and more specifically a non-connected socket.
- -- Fail silently.
procedure Connect_Socket
(Socket : Socket_Type;
-- 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
Tref : Entity_Id;
-- Type reference
+ Rref : Node_Id;
+ -- Renaming reference
+
Trunit : Unit_Number_Type;
-- Unit number for type reference
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 := '{';
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
end if;
end loop;
+ -- End of processing for entity output
+
Curru := Curxu;
Crloc := No_Location;
end if;
--
-- 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.
--
-- 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=()
-- 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
--
--
-- 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.
projects / gcc.git / commitdiff