Patchwork [Ada] Catch more redundant conversions with -gnatwr

login
register
mail settings
Submitter Arnaud Charlet
Date Sept. 9, 2010, 12:18 p.m.
Message ID <20100909121828.GA21216@adacore.com>
Download mbox | patch
Permalink /patch/64289/
State New
Headers show

Comments

Arnaud Charlet - Sept. 9, 2010, 12:18 p.m.
This patch catches many more cases of redundant type conversions
if -gnatyr is used. As far as we know, this does not add any false
positives. In the following test, compiled with -gnatj60 -gnatld7
-gnatwr shows several cases caught by the patch (prior to this
patch, only the last case was detected):

     1. procedure Conversion_To_Itself is
     2.
     3.    function Integer_Identity
     4.      (I : Integer) return Integer
     5.    is
     6.    begin
     7.       return I;
     8.    end Integer_Identity;
     9.
    10.    I : Integer := 1;
    11.    J : Integer;
    12.
    13.    type My_Enum is (A, B, C);
    14.
    15.    function Enum_Identity (X : My_Enum) return My_Enum is
    16.    begin
    17.       return X;
    18.    end Enum_Identity;
    19.
    20.    My_Enum_Var_1 : My_Enum := A;
    21.    My_Enum_Var_2 : My_Enum;
    22.
    23.    type My_Array is array (1 .. 10) of Integer;
    24.    My_Array_Var : My_Array := (others => 0);
    25.
    26. begin
    27.    J := Integer (Integer_Identity (I));
                |
        >>> warning: redundant conversion, expression is of
            type "Integer"

    28.
    29.    My_Enum_Var_2 :=
    30.      My_Enum (Enum_Identity (My_Enum_Var_1));
             |
        >>> warning: redundant conversion, expression is of
            type "My_Enum"

    31.
    32.    My_Array_Var (1) := Integer (My_Array_Var (1));
                               |
        >>> warning: redundant conversion, expression is of
            type "Integer"

    33.
    34.    My_Array_Var (3) := Integer (J);
                               |
        >>> warning: redundant conversion, "J" is of type
            "Integer"

    35.    --  Only this conversion was flagged
    36.
    37. end Conversion_To_Itself;

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

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb (Resolve_Type_Conversion): Catch more cases of redundant
	conversions.

Patch

Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 164072)
+++ sem_res.adb	(working copy)
@@ -6505,13 +6505,10 @@  package body Sem_Res is
          --  be anonymous access types.
 
          elsif Ada_Version >= Ada_2012
-           and then Ekind_In (Etype (L),
-             E_Anonymous_Access_Type,
-               E_Anonymous_Access_Subprogram_Type)
-
-           and then Ekind_In (Etype (R),
-             E_Anonymous_Access_Type,
-               E_Anonymous_Access_Subprogram_Type)
+           and then Ekind_In (Etype (L), E_Anonymous_Access_Type,
+                                         E_Anonymous_Access_Subprogram_Type)
+           and then Ekind_In (Etype (R), E_Anonymous_Access_Type,
+                                         E_Anonymous_Access_Subprogram_Type)
          then
             Check_Conditional_Expression (L);
             Check_Conditional_Expression (R);
@@ -8655,6 +8652,10 @@  package body Sem_Res is
       Orig_N      : Node_Id;
       Orig_T      : Node_Id;
 
+      Test_Redundant : Boolean := Warn_On_Redundant_Constructs;
+      --  Set to False to suppress cases where we want to suppress the test
+      --  for redundancy to avoid possible false positives on this warning.
+
    begin
       if not Conv_OK
         and then not Valid_Conversion (N, Target_Typ, Operand)
@@ -8662,7 +8663,20 @@  package body Sem_Res is
          return;
       end if;
 
-      if Etype (Operand) = Any_Fixed then
+      --  If the Operand Etype is Universal_Fixed, then the conversion is
+      --  never redundant. We need this check because by the time we have
+      --  finished the rather complex transformation, the conversion looks
+      --  redundant when it is not.
+
+      if Operand_Typ = Universal_Fixed then
+         Test_Redundant := False;
+
+      --  If the operand is marked as Any_Fixed, then special processing is
+      --  required. This is also a case where we suppress the test for a
+      --  redundant conversion, since most certainly it is not redundant.
+
+      elsif Operand_Typ = Any_Fixed then
+         Test_Redundant := False;
 
          --  Mixed-mode operation involving a literal. Context must be a fixed
          --  type which is applied to the literal subsequently.
@@ -8768,9 +8782,13 @@  package body Sem_Res is
 
       Orig_N := Original_Node (N);
 
-      if Warn_On_Redundant_Constructs
-        and then Comes_From_Source (Orig_N)
+      --  Here we test for a redundant conversion if the warning mode is
+      --  active (and was not locally reset), and we have a type conversion
+      --  from source not appearing in a generic instance.
+
+      if Test_Redundant
         and then Nkind (Orig_N) = N_Type_Conversion
+        and then Comes_From_Source (Orig_N)
         and then not In_Instance
       then
          Orig_N := Original_Node (Expression (Orig_N));
@@ -8786,12 +8804,21 @@  package body Sem_Res is
             Orig_T := Etype (Parent (N));
          end if;
 
-         if Is_Entity_Name (Orig_N)
-           and then
-             (Etype (Entity (Orig_N)) = Orig_T
-                or else
-                  (Ekind (Entity (Orig_N)) = E_Loop_Parameter
-                    and then Covers (Orig_T, Etype (Entity (Orig_N)))))
+         --  if we have an entity name, then give the warning if the entity
+         --  is the right type, or if it is a loop parameter covered by the
+         --  original type (that's needed because loop parameters have an
+         --  odd subtype coming from the bounds).
+
+         if (Is_Entity_Name (Orig_N)
+               and then
+                 (Etype (Entity (Orig_N)) = Orig_T
+                   or else
+                     (Ekind (Entity (Orig_N)) = E_Loop_Parameter
+                      and then Covers (Orig_T, Etype (Entity (Orig_N))))))
+
+         --  If not an entity, then type of expression must match
+
+           or else Etype (Orig_N) = Orig_T
          then
             --  One more check, do not give warning if the analyzed conversion
             --  has an expression with non-static bounds, and the bounds of the
@@ -8804,13 +8831,21 @@  package body Sem_Res is
             then
                null;
 
-            --  Here we give the redundant conversion warning
+            --  Here we give the redundant conversion warning. If it is an
+            --  entity, give the name of the entity in the message. If not,
+            --  just mention the expression.
 
             else
-               Error_Msg_Node_2 := Orig_T;
-               Error_Msg_NE -- CODEFIX
-                 ("?redundant conversion, & is of type &!",
-                  N, Entity (Orig_N));
+               if Is_Entity_Name (Orig_N) then
+                  Error_Msg_Node_2 := Orig_T;
+                  Error_Msg_NE -- CODEFIX
+                    ("?redundant conversion, & is of type &!",
+                     N, Entity (Orig_N));
+               else
+                  Error_Msg_NE
+                    ("?redundant conversion, expression is of type&!",
+                     N, Orig_T);
+               end if;
             end if;
          end if;
       end if;
@@ -9129,7 +9164,6 @@  package body Sem_Res is
 
       Resolve (Operand, Opnd_Type);
       Eval_Unchecked_Conversion (N);
-
    end Resolve_Unchecked_Type_Conversion;
 
    ------------------------------