===================================================================
@@ -6663,8 +6663,17 @@
function Is_LHS (N : Node_Id) return Boolean is
P : constant Node_Id := Parent (N);
begin
- return Nkind (P) = N_Assignment_Statement
- and then Name (P) = N;
+ if Nkind (P) = N_Assignment_Statement then
+ return Name (P) = N;
+
+ elsif
+ Nkind_In (P, N_Indexed_Component, N_Selected_Component, N_Slice)
+ then
+ return N = Prefix (P) and then Is_LHS (P);
+
+ else
+ return False;
+ end if;
end Is_LHS;
----------------------------
===================================================================
@@ -4574,10 +4574,21 @@
--
-- The Is_Actual_Parameter routine takes care of one of these
-- cases but there are others probably ???
+ --
+ -- If the entity is the LHS of an assignment, and is a variable
+ -- (rather than a package prefix), we can mark it as a
+ -- modification right away, to avoid duplicate references.
else
if not Is_Actual_Parameter then
- Generate_Reference (E, N);
+ if Is_LHS (N)
+ and then Ekind (E) /= E_Package
+ and then Ekind (E) /= E_Generic_Package
+ then
+ Generate_Reference (E, N, 'm');
+ else
+ Generate_Reference (E, N);
+ end if;
end if;
Check_Nested_Access (E);
@@ -4980,7 +4991,12 @@
Set_Entity (N, Id);
else
Set_Entity_Or_Discriminal (N, Id);
- Generate_Reference (Id, N);
+
+ if Is_LHS (N) then
+ Generate_Reference (Id, N, 'm');
+ else
+ Generate_Reference (Id, N);
+ end if;
end if;
if Is_Type (Id) then
===================================================================
@@ -1377,6 +1377,9 @@
Ctyp : Character;
-- Entity type character
+ Prevt : Character;
+ -- reference kind of previous reference
+
Tref : Entity_Id;
-- Type reference
@@ -1519,6 +1522,7 @@
Curdef := No_Location;
Curru := No_Unit;
Crloc := No_Location;
+ Prevt := 'm';
-- Loop to output references
@@ -2193,12 +2197,17 @@
Crloc := No_Location;
end if;
- -- Output the reference
+ -- Output the reference if it is not as the same location
+ -- as the previous one, or it is a read-reference that
+ -- indicates that the entity is an in-out actual in a call.
if XE.Loc /= No_Location
- and then XE.Loc /= Crloc
+ and then
+ (XE.Loc /= Crloc
+ or else (Prevt = 'm' and then XE.Typ = 'r'))
then
Crloc := XE.Loc;
+ Prevt := XE.Typ;
-- Start continuation if line full, else blank
The ali file not includes both a read and modify reference for an entity that is an actual for an in-out parameter. The following commands: gcc -c gp.adb grep G{integer} gp.ali must yield: 2i4*G{integer} 2|9m14 9r14 --- package GP is G : Integer; procedure Indirect_Read_Write; end GP; --- package body GP is procedure Indirect_Read_Write is procedure Local (Proxy : in out Integer) is pragma Precondition (Proxy < Integer'Last); begin Proxy := Proxy + 1; end Local; begin Local (G); end Indirect_Read_Write; end GP; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-01 Ed Schonberg <schonberg@adacore.com> * sem_ch8.adb (Find_Direct_Name, Analyze_Expanded_Name): use Is_LHS to better determine whether an entity reference is a write. * sem_util.adb (Is_LHS): refine predicate to handle assignment to a subcomponent. * lib-xref.adb (Output_References): Do no suppress a read reference at the same location as an immediately preceeding modify-reference, to handle properly in-out actuals.