diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 28 | ||||
| -rw-r--r-- | gcc/ada/ali.adb | 32 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 53 | ||||
| -rw-r--r-- | gcc/ada/g-socket.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.adb | 53 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.ads | 52 |
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. |