diff options
| -rw-r--r-- | gcc/ada/einfo.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/lib.adb | 96 | ||||
| -rw-r--r-- | gcc/ada/lib.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 13 |
5 files changed, 41 insertions, 85 deletions
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index d71dcaf..94022e7 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1865,7 +1865,7 @@ package Einfo is -- Has_Per_Object_Constraint -- Defined in E_Component entities. Set if the subtype of the component -- has a per object constraint. Per object constraints result from the --- following situations : +-- following situations: -- -- 1. N_Attribute_Reference - when the prefix is the enclosing type and -- the attribute is Access. @@ -4136,14 +4136,14 @@ package Einfo is -- set instead, or a similar appearance as an out parameter actual, in -- which case Referenced_As_Out_Parameter is set. --- Referenced_As_LHS : +-- Referenced_As_LHS -- Defined in all entities. This flag is set instead of Referenced if a -- simple variable that is not a renaming appears as the left side of an -- assignment. The reason we distinguish this kind of reference is that -- we have a separate warning for variables that are only assigned and -- never read. --- Referenced_As_Out_Parameter : +-- Referenced_As_Out_Parameter -- Defined in all entities. This flag is set instead of Referenced if a -- simple variable that is not a renaming appears as an actual for an out -- formal. The reason we distinguish this kind of reference is that diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 261ba2e..1510966 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -53,7 +53,7 @@ with Stand; use Stand; with Stylesw; use Stylesw; with System.OS_Lib; with Uname; use Uname; -with Warnsw; pragma Unreferenced (Warnsw); -- disable spurious warning +with Warnsw; package body Errout is diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 691d8e4..68ae46a 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -320,15 +320,13 @@ package body Lib is begin if S1 = No_Location or else S2 = No_Location then return No; + end if; - elsif S1 = Standard_Location then - if S2 = Standard_Location then - return Yes_Same; - else - return No; - end if; + if S1 = S2 then + return Yes_Same; + end if; - elsif S2 = Standard_Location then + if S1 = Standard_Location or else S2 = Standard_Location then return No; end if; @@ -841,53 +839,36 @@ package body Lib is (N : Node_Or_Entity_Id) return Boolean is begin - if Sloc (N) = Standard_Location then - return False; - - elsif Sloc (N) = No_Location then - return False; - -- Special case Itypes to test the Sloc of the associated node. The -- reason we do this is for possible calls from gigi after -gnatD -- processing is complete in sprint. This processing updates the -- sloc fields of all nodes in the tree, but itypes are not in the -- tree so their slocs do not get updated. - elsif Nkind (N) = N_Defining_Identifier - and then Is_Itype (N) - then + if Nkind (N) = N_Defining_Identifier and then Is_Itype (N) then return In_Extended_Main_Code_Unit (Associated_Node_For_Itype (N)); - - -- Otherwise see if we are in the main unit - - elsif Get_Code_Unit (Sloc (N)) = Get_Code_Unit (Cunit (Main_Unit)) then - return True; - - -- Node may be in spec (or subunit etc) of main unit - - else - return In_Same_Extended_Unit (N, Cunit (Main_Unit)); end if; + + return In_Extended_Main_Code_Unit (Sloc (N)); end In_Extended_Main_Code_Unit; function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean is begin - if Loc = Standard_Location then - return False; + -- Special value cases - elsif Loc = No_Location then + if Loc in No_Location | Standard_Location then return False; + end if; -- Otherwise see if we are in the main unit - elsif Get_Code_Unit (Loc) = Get_Code_Unit (Cunit (Main_Unit)) then + if Get_Code_Unit (Loc) = Get_Code_Unit (Cunit (Main_Unit)) then return True; + end if; -- Location may be in spec (or subunit etc) of main unit - else - return In_Same_Extended_Unit (Loc, Sloc (Cunit (Main_Unit))); - end if; + return In_Same_Extended_Unit (Loc, Sloc (Cunit (Main_Unit))); end In_Extended_Main_Code_Unit; ---------------------------------- @@ -897,69 +878,42 @@ package body Lib is function In_Extended_Main_Source_Unit (N : Node_Or_Entity_Id) return Boolean is - Nloc : constant Source_Ptr := Sloc (N); - Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit)); - begin - -- If parsing, then use the global flag to indicate result - - if Compiler_State = Parsing then - return Parsing_Main_Extended_Source; - - -- Special value cases - - elsif Nloc = Standard_Location then - return False; - - elsif Nloc = No_Location then - return False; - -- Special case Itypes to test the Sloc of the associated node. The -- reason we do this is for possible calls from gigi after -gnatD -- processing is complete in sprint. This processing updates the -- sloc fields of all nodes in the tree, but itypes are not in the -- tree so their slocs do not get updated. - elsif Nkind (N) = N_Defining_Identifier - and then Is_Itype (N) - then + if Nkind (N) = N_Defining_Identifier and then Is_Itype (N) then + pragma Assert (Compiler_State /= Parsing); return In_Extended_Main_Source_Unit (Associated_Node_For_Itype (N)); - - -- Otherwise compare original locations to see if in same unit - - else - return - In_Same_Extended_Unit - (Original_Location (Nloc), Original_Location (Mloc)); end if; + + return In_Extended_Main_Source_Unit (Sloc (N)); end In_Extended_Main_Source_Unit; function In_Extended_Main_Source_Unit (Loc : Source_Ptr) return Boolean is - Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit)); - begin -- If parsing, then use the global flag to indicate result if Compiler_State = Parsing then return Parsing_Main_Extended_Source; + end if; -- Special value cases - elsif Loc = Standard_Location then - return False; - - elsif Loc = No_Location then + if Loc in No_Location | Standard_Location then return False; + end if; - -- Otherwise compare original locations to see if in same unit + -- Otherwise compare original locations - else - return - In_Same_Extended_Unit - (Original_Location (Loc), Original_Location (Mloc)); - end if; + return In_Same_Extended_Unit + (Original_Location (Loc), + Original_Location (Sloc (Cunit (Main_Unit)))); end In_Extended_Main_Source_Unit; ---------------------- diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index c308ac1..6937eed 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -46,7 +46,7 @@ package Lib is Parsing_Main_Extended_Source : Boolean := False; -- Set True if we are currently parsing a file that is part of the main -- extended source (the main unit, its spec, or one of its subunits). This - -- flag to implement In_Extended_Main_Source_Unit. + -- is used to implement In_Extended_Main_Source_Unit. Analysing_Subunit_Of_Main : Boolean := False; -- Set to True when analyzing a subunit of the main source. When True, if @@ -616,8 +616,7 @@ package Lib is -- WARNING: There is a matching C declaration of this subprogram in fe.h function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean; - -- Same function as above, but argument is a source pointer rather - -- than a node. + -- Same as above, but for Source_Ptr function In_Extended_Main_Source_Unit (N : Node_Or_Entity_Id) return Boolean; @@ -631,7 +630,7 @@ package Lib is -- and the parent unit spec if it is separate. function In_Extended_Main_Source_Unit (Loc : Source_Ptr) return Boolean; - -- Same function as above, but argument is a source pointer + -- Same as above, but for Source_Ptr function ipu (N : Node_Or_Entity_Id) return Boolean; -- Same as In_Predefined_Unit, but renamed so it can assist debugging. @@ -646,7 +645,7 @@ package Lib is function In_Predefined_Unit (S : Source_Ptr) return Boolean; pragma Inline (In_Predefined_Unit); - -- Same function as above but argument is a source pointer + -- Same as above, but for Source_Ptr function In_Internal_Unit (N : Node_Or_Entity_Id) return Boolean; function In_Internal_Unit (S : Source_Ptr) return Boolean; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 344b3eb..a8834b8 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1154,13 +1154,16 @@ package body Sem_Ch5 is Record_Elaboration_Scenario (N); - -- Set Referenced_As_LHS if appropriate. We only set this flag if the - -- assignment is a source assignment in the extended main source unit. - -- We are not interested in any reference information outside this - -- context, or in compiler generated assignment statements. + -- Set Referenced_As_LHS if appropriate. We are not interested in + -- compiler-generated assignment statements, nor in references outside + -- the extended main source unit. We check whether the Original_Node is + -- in the extended main source unit because in the case of a renaming of + -- a component of a packed array, the Lhs itself has a Sloc from the + -- place of the renaming. if Comes_From_Source (N) - and then In_Extended_Main_Source_Unit (Lhs) + and then (In_Extended_Main_Source_Unit (Lhs) + or else In_Extended_Main_Source_Unit (Original_Node (Lhs))) then Set_Referenced_Modified (Lhs, Out_Param => False); end if; |