2009-10-27 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 27 Oct 2009 14:02:58 +0000 (14:02 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 27 Oct 2009 14:02:58 +0000 (14:02 +0000)
* sem_warn.adb, sem_util.adb, sem_util.ads: Minor reformatting. Add
comments.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153595 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads
gcc/ada/sem_warn.adb

index cabdaee..794901f 100644 (file)
@@ -1,5 +1,10 @@
 2009-10-27  Robert Dewar  <dewar@adacore.com>
 
+       * sem_warn.adb, sem_util.adb, sem_util.ads: Minor reformatting. Add
+       comments.
+
+2009-10-27  Robert Dewar  <dewar@adacore.com>
+
        * s-os_lib.ads, s-os_lib.adb, prj-err.adb, makeutl.adb: Minor
        reformatting.
 
index 5dcd715..9c8de04 100644 (file)
@@ -2142,26 +2142,35 @@ package body Sem_Util is
    -------------------------
 
    function Denotes_Same_Object (A1, A2 : Node_Id) return Boolean is
-
    begin
+      --  If we have entity names, then must be same entity
+
       if Is_Entity_Name (A1) then
          if Is_Entity_Name (A2)then
-            return  Entity (A1) = Entity (A2);
+            return Entity (A1) = Entity (A2);
          else
             return False;
          end if;
 
+      --  No match if not same node kind
+
       elsif Nkind (A1) /= Nkind (A2) then
          return False;
 
+      --  For selected components, must have same prefix and selector
+
       elsif Nkind (A1) = N_Selected_Component then
          return Denotes_Same_Object (Prefix (A1), Prefix (A2))
            and then
          Entity (Selector_Name (A1)) = Entity (Selector_Name (A2));
 
+      --  For explicit dereferences, prefixes must be same
+
       elsif Nkind (A1) = N_Explicit_Dereference then
          return Denotes_Same_Object (Prefix (A1), Prefix (A2));
 
+      --  For indexed components, prefixes and all subscripts must be the same
+
       elsif Nkind (A1) = N_Indexed_Component then
          if Denotes_Same_Object (Prefix (A1), Prefix (A2)) then
             declare
@@ -2172,6 +2181,9 @@ package body Sem_Util is
                Indx1 := First (Expressions (A1));
                Indx2 := First (Expressions (A2));
                while Present (Indx1) loop
+
+                  --  Shouldn't we be checking that values are the same???
+
                   if not Denotes_Same_Object (Indx1, Indx2) then
                      return False;
                   end if;
@@ -2186,6 +2198,8 @@ package body Sem_Util is
             return False;
          end if;
 
+      --  For slices, prefixes must match and bounds must match
+
       elsif Nkind (A1) = N_Slice
         and then Denotes_Same_Object (Prefix (A1), Prefix (A2))
       then
@@ -2196,14 +2210,17 @@ package body Sem_Util is
             Get_Index_Bounds (Etype (A1), Lo1, Hi1);
             Get_Index_Bounds (Etype (A2), Lo2, Hi2);
 
-            --  Check whether bounds are statically identical
-            --  No attempt to detect partial overlap of slices.
+            --  Check whether bounds are statically identical. There is no
+            --  attempt to detect partial overlap of slices.
+
+            --  What about an array and a slice of an array???
 
             return Denotes_Same_Object (Lo1, Lo2)
               and then Denotes_Same_Object (Hi1, Hi2);
          end;
 
-         --  Literals will appear as indices.
+         --  Literals will appear as indices. Isn't this where we should check
+         --  Known_At_Compile_Time at least if we are generating warnings ???
 
       elsif Nkind (A1) = N_Integer_Literal then
          return Intval (A1) = Intval (A2);
index b9a52ed..623a72b 100644 (file)
@@ -254,8 +254,11 @@ package Sem_Util is
    function Denotes_Same_Object (A1, A2 : Node_Id) return Boolean;
    function Denotes_Same_Prefix (A1, A2 : Node_Id) return Boolean;
    --  Functions to detect suspicious overlapping between actuals in a call,
-   --  when one of them is writable. The predicates are those  proposed in
+   --  when one of them is writable. The predicates are those proposed in
    --  AI05-0144, to detect dangerous order dependence in complex calls.
+   --  I would add a parameter Warn which enables more extensive testing of
+   --  cases as we find appropriate when we are only warning ??? Or perhaps
+   --  return an indication of (Error, Warn, OK) ???
 
    function Denotes_Variable (N : Node_Id) return Boolean;
    --  Returns True if node N denotes a single variable without parentheses
index f9e82cc..f8124f2 100644 (file)
@@ -3544,8 +3544,9 @@ package body Sem_Warn is
       Form1, Form2 : Entity_Id;
 
    begin
-
-      --  For now, treat this warning as an extension.
+      --  For now, treat this warning as an extension
+      --  Why not just define a new warning switch, you really don't want to
+      --  force this warning when using conditional expressions for example???
 
       if not Extensions_Allowed then
          return;
@@ -3554,7 +3555,7 @@ package body Sem_Warn is
       --  Exclude calls rewritten as enumeration literals
 
       if not Nkind_In
-        (N, N_Function_Call, N_Procedure_Call_Statement)
+               (N, N_Function_Call, N_Procedure_Call_Statement)
       then
          return;
       end if;
@@ -3570,22 +3571,23 @@ package body Sem_Warn is
 
       Form1 := First_Formal (Subp);
       Act1  := First_Actual (N);
-
       while Present (Form1) and then Present (Act1) loop
          if Ekind (Form1) = E_In_Out_Parameter then
             Form2 := First_Formal (Subp);
             Act2  := First_Actual (N);
-
             while Present (Form2) and then Present (Act2) loop
                if Form1 /= Form2
                  and then Ekind (Form2) /= E_Out_Parameter
                  and then
                    (Denotes_Same_Object (Act1, Act2)
-                    or else Denotes_Same_Prefix (Act1, Act2))
+                      or else
+                    Denotes_Same_Prefix (Act1, Act2))
                then
-
                   --  Exclude generic types and guard against previous errors.
-                  --  If either type is elementary the aliasing is harmless
+                  --  If either type is elementary the aliasing is harmless.
+
+                  --  I can't relate the comment about elementary to the
+                  --  actual code below, which seems to be testing generic???
 
                   if Error_Posted (N)
                     or else No (Etype (Act1))
@@ -3605,15 +3607,19 @@ package body Sem_Warn is
                      null;
 
                   elsif Is_Elementary_Type (Underlying_Type (Etype (Form1)))
-                    or else
-                      Is_Elementary_Type (Underlying_Type (Etype (Form2)))
+                          or else
+                        Is_Elementary_Type (Underlying_Type (Etype (Form2)))
                   then
                      null;
+
                   else
                      declare
                         Act  : Node_Id;
                         Form : Entity_Id;
+
                      begin
+                        --  Find matching actual
+
                         Act  := First_Actual (N);
                         Form := First_Formal (Subp);
                         while Act /= Act2 loop
@@ -3624,6 +3630,8 @@ package body Sem_Warn is
                         --  If the call was written in prefix notation, count
                         --  only the visible actuals in the call.
 
+                        --  Why original_node calls below ???
+
                         if Is_Entity_Name (First_Actual (N))
                           and then Nkind (Original_Node (N)) = Nkind (N)
                           and then
@@ -3641,8 +3649,8 @@ package body Sem_Warn is
                                  Act1, Form);
                            else
                               Error_Msg_FE
-                             ("writable actual overlaps with actual for&?",
-                              Act1, Form);
+                                ("writable actual overlaps with actual for&?",
+                                 Act1, Form);
                            end if;
 
                         else
@@ -3652,6 +3660,7 @@ package body Sem_Warn is
                         end if;
                      end;
                   end if;
+
                   return;
                end if;