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 <schonb...@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.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 177027)
+++ sem_util.adb (working copy)
@@ -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;
----------------------------
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 176998)
+++ sem_ch8.adb (working copy)
@@ -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
Index: lib-xref.adb
===================================================================
--- lib-xref.adb (revision 176998)
+++ lib-xref.adb (working copy)
@@ -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
