diff mbox

[Ada] Fix detection of unmodified variables in -gnatc mode

Message ID 20140123163653.GA5237@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Jan. 23, 2014, 4:36 p.m. UTC
For an implicit dereference such as J.K where J is of an access
type, the compiler incorrectly assumed that an assignment to
J.K would modify J if operating in semantics only (-gnatc) mode.
The following example gives the warning indicated if compiled
with -gnatwa with or without -gnatc

     1. procedure BadUnmodC is
     2.    package Db_G is
     3.       type Access_Int is private;
     4.       procedure Modify_Via_Access
     5.         (Ptr1 : in out Access_Int;
     6.          Ptr2 : in out Access_Int);
     7.       pragma Unreferenced (Modify_Via_Access);
     8.    private
     9.       type Rec;
    10.       type Access_Int is access Rec;
    11.    end;
    12.    pragma Unreferenced (Db_G);
    13.    package body Db_G is
    14.       type Rec is
    15.          record
    16.             I : Integer;
    17.          end record;
    18.       procedure Modify (I : in out Integer) is
    19.       begin
    20.          I := I + 1;
    21.       end;
    22.       procedure Modify_Via_Access
    23.         (Ptr1 : in out Access_Int;
    24.          Ptr2 : in out Access_Int)
                 |
        >>> warning: formal parameter "Ptr2" is not
            modified, mode could be "in" instead of "in out"

    25.       is
    26.          pragma Unmodified (Ptr1);
    27.       begin
    28.          Modify (Ptr1.I);
    29.          Modify (Ptr2.I);
    30.       end;
    31.    end;
    32. begin
    33.    null;
    34. end;

Previously, this warning was missed in -gnatc mode, and instead
there was a bogus complaint about the pragma Unmodified.

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-01-23  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb (Note_Possible_Modification): Fix error of
	misbehaving for implicit dereference cases in -gnatc mode.
diff mbox

Patch

Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 206918)
+++ sem_util.adb	(working copy)
@@ -13344,7 +13344,6 @@ 
 
       Exp := N;
       loop
-         <<Continue>>
          Ent := Empty;
 
          if Is_Entity_Name (Exp) then
@@ -13370,8 +13369,7 @@ 
                end if;
 
                if Nkind (P) = N_Selected_Component
-                 and then
-                   Present (Entry_Formal (Entity (Selector_Name (P))))
+                 and then Present (Entry_Formal (Entity (Selector_Name (P))))
                then
                   --  Case of a reference to an entry formal
 
@@ -13380,8 +13378,8 @@ 
                elsif Nkind (P) = N_Identifier
                  and then Nkind (Parent (Entity (P))) = N_Object_Declaration
                  and then Present (Expression (Parent (Entity (P))))
-                 and then Nkind (Expression (Parent (Entity (P))))
-                   = N_Reference
+                 and then Nkind (Expression (Parent (Entity (P)))) =
+                                                               N_Reference
                then
                   --  Case of a reference to a value on which side effects have
                   --  been removed.
@@ -13391,7 +13389,6 @@ 
 
                else
                   return;
-
                end if;
             end;
 
@@ -13405,9 +13402,25 @@ 
                               N_Indexed_Component,
                               N_Selected_Component)
          then
-            Exp := Prefix (Exp);
-            goto Continue;
+            --  Special check, if the prefix is an access type, then return
+            --  since we are modifying the thing pointed to, not the prefix.
+            --  When we are expanding, most usually the prefix is replaced
+            --  by an explicit dereference, and this test is not needed, but
+            --  in some cases (notably -gnatc mode and generics) when we do
+            --  not do full expansion, we need this special test.
 
+            if Is_Access_Type (Etype (Prefix (Exp))) then
+               return;
+
+            --  Otherwise go to prefix and keep going
+
+            else
+               Exp := Prefix (Exp);
+               goto Continue;
+            end if;
+
+         --  All other cases, not a modification
+
          else
             return;
          end if;
@@ -13539,6 +13552,9 @@ 
 
             return;
          end if;
+
+      <<Continue>>
+         null;
       end loop;
    end Note_Possible_Modification;