re PR fortran/47659 (-Wconversion[-extra] should emit warning for constant expressions)

2011-08-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/47659
	* expr.c (gfc_check_assign): Check for type conversions when the
	right-hand side is a constant REAL/COMPLEX contstant the left-hand
	side is also REAL/COMPLEX.  Don't warn when a narrowing conversion
	for REAL does not change the value of the constant.

2011-08-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/47659
	* gfortran.dg/warn_conversion_2.f90:  Also warn about conversion
	of a constant resulting from simplification.
	* gfortran.dg/warn_conversion_3.f90:  New test.

From-SVN: r177942

1 files changed, 47 insertions, 0 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 549feee..6d94369 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3190,6 +3190,53 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
 	}
     }
 
+  /*  Warn about type-changing conversions for REAL or COMPLEX constants.
+      If lvalue and rvalue are mixed REAL and complex, gfc_compare_types
+      will warn anyway, so there is no need to to so here.  */
+
+  if (rvalue->expr_type == EXPR_CONSTANT && lvalue->ts.type == rvalue->ts.type
+      && (lvalue->ts.type == BT_REAL || lvalue->ts.type == BT_COMPLEX))
+    {
+      if (lvalue->ts.kind < rvalue->ts.kind && gfc_option.gfc_warn_conversion)
+	{
+	  /* As a special bonus, don't warn about REAL rvalues which are not
+	     changed by the conversion if -Wconversion is specified.  */
+	  if (rvalue->ts.type == BT_REAL && mpfr_number_p (rvalue->value.real))
+	    {
+	      /* Calculate the difference between the constant and the rounded
+		 value and check it against zero.  */
+	      mpfr_t rv, diff;
+	      gfc_set_model_kind (lvalue->ts.kind);
+	      mpfr_init (rv);
+	      gfc_set_model_kind (rvalue->ts.kind);
+	      mpfr_init (diff);
+	      
+	      mpfr_set (rv, rvalue->value.real, GFC_RND_MODE);
+	      mpfr_sub (diff, rv, rvalue->value.real, GFC_RND_MODE);
+	  
+	      if (!mpfr_zero_p (diff))
+		gfc_warning ("Change of value in conversion from "
+			     " %s to %s at %L", gfc_typename (&rvalue->ts),
+			     gfc_typename (&lvalue->ts), &rvalue->where);
+	      
+	      mpfr_clear (rv);
+	      mpfr_clear (diff);
+	    }
+	  else
+	    gfc_warning ("Possible change of value in conversion from %s "
+			 "to %s at %L",gfc_typename (&rvalue->ts),
+			 gfc_typename (&lvalue->ts), &rvalue->where);
+
+	}
+      else if (gfc_option.warn_conversion_extra
+	       && lvalue->ts.kind > rvalue->ts.kind)
+	{
+	  gfc_warning ("Conversion from %s to %s at %L",
+		       gfc_typename (&rvalue->ts),
+		       gfc_typename (&lvalue->ts), &rvalue->where);
+	}
+    }
+
   if (gfc_compare_types (&lvalue->ts, &rvalue->ts))
     return SUCCESS;