+2015-06-06 Thomas Koenig <tkoenig@netcologne.de>
+
+ PR fortran/47359
+ * arith.c (eval_intrinsic_op): Set warn flag for
+ gfc_type_convert_binary if -Wconversion or -Wconversion-extra
+ are set.
+ (wprecision_real_real): New function.
+ (wprecision_int_real): New function.
+ (gfc_int2int): If -fno-range-check and -Wconversion are specified
+ and it is a narrowing conversion, warn.
+ (gfc_int2real): If there is a change in value for the conversion,
+ warn.
+ (gfc_int2complex): Likewise.
+ (gfc_real2int): If there is a fractional part to the real number,
+ warn with -Wconversion, otherwise warn with -Wconversion-extra.
+ (gfc_real2real): Emit warning if the constant was changed by
+ conversion with either -Wconversion or -Wconversion-extra. With
+ -Wconversion-extra, warn if no warning was issued earlier.
+ (gfc_real2complex): Likewise.
+ (gfc_complex2int): For -Wconversion or -Wconversion-extra, if
+ there was an imaginary part, warn; otherwise, warn for change in
+ value. Warn with -Wconversion-extra if no other warning was
+ issued.
+ (gfc_complex2real): For -Wconversion or -Wconversion-extra, if
+ there was an imaginary part, warn; otherwise, warn for change in
+ value. Warn with -Wconversion-extra if no other warning was
+ issued.
+ (gfc_complex2complex): For -Wconversion, warn if the value of
+ either the real or the imaginary part was changed. Warn for
+ -Wconversion-extra if no prior warning was issued.
+ * expr.c (gfc_check_assign): Remove check for change in value.
+ * primary.c (match_real_constant): For -Wconversion-extra, check
+ against a number in which the last non-zero digit has been
+ replaced with a zero. If the number compares equal, warn.
+ * intrinsic.c (gfc_convert_type_warn): Do not warn about constant
+ conversions.
+
2015-06-05 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/66347
temp.value.op.op1 = op1;
temp.value.op.op2 = op2;
- gfc_type_convert_binary (&temp, 0);
+ gfc_type_convert_binary (&temp, warn_conversion || warn_conversion_extra);
if (op == INTRINSIC_EQ || op == INTRINSIC_NE
|| op == INTRINSIC_GE || op == INTRINSIC_GT
NaN, etc. */
}
+/* Returns true if significant bits were lost when converting real
+ constant r from from_kind to to_kind. */
+
+static bool
+wprecision_real_real (mpfr_t r, int from_kind, int to_kind)
+{
+ mpfr_t rv, diff;
+ bool ret;
+
+ gfc_set_model_kind (to_kind);
+ mpfr_init (rv);
+ gfc_set_model_kind (from_kind);
+ mpfr_init (diff);
+
+ mpfr_set (rv, r, GFC_RND_MODE);
+ mpfr_sub (diff, rv, r, GFC_RND_MODE);
+
+ ret = ! mpfr_zero_p (diff);
+ mpfr_clear (rv);
+ mpfr_clear (diff);
+ return ret;
+}
+
+/* Return true if conversion from an integer to a real loses precision. */
+
+static bool
+wprecision_int_real (mpz_t n, mpfr_t r)
+{
+ mpz_t i;
+ mpz_init (i);
+ mpfr_get_z (i, r, GFC_RND_MODE);
+ mpz_sub (i, i, n);
+ return mpz_cmp_si (i, 0) != 0;
+ mpz_clear (i);
+
+}
/* Convert integers to integers. */
k = gfc_validate_kind (BT_INTEGER, kind, false);
gfc_convert_mpz_to_signed (result->value.integer,
gfc_integer_kinds[k].bit_size);
- }
+ if (warn_conversion && kind < src->ts.kind)
+ gfc_warning_now (OPT_Wconversion, "Conversion from %qs to %qs at %L",
+ gfc_typename (&src->ts), gfc_typename (&result->ts),
+ &src->where);
+ }
return result;
}
return NULL;
}
+ if (warn_conversion
+ && wprecision_int_real (src->value.integer, result->value.real))
+ gfc_warning_now (OPT_Wconversion, "Change of value in conversion "
+ "from %qs to %qs at %L",
+ gfc_typename (&src->ts),
+ gfc_typename (&result->ts),
+ &src->where);
+
return result;
}
return NULL;
}
+ if (warn_conversion
+ && wprecision_int_real (src->value.integer,
+ mpc_realref (result->value.complex)))
+ gfc_warning_now (OPT_Wconversion, "Change of value in conversion "
+ "from %qs to %qs at %L",
+ gfc_typename (&src->ts),
+ gfc_typename (&result->ts),
+ &src->where);
+
return result;
}
{
gfc_expr *result;
arith rc;
+ bool did_warn = false;
result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
return NULL;
}
+ /* If there was a fractional part, warn about this. */
+
+ if (warn_conversion)
+ {
+ mpfr_t f;
+ mpfr_init (f);
+ mpfr_frac (f, src->value.real, GFC_RND_MODE);
+ if (mpfr_cmp_si (f, 0) != 0)
+ {
+ gfc_warning_now (OPT_Wconversion, "Change of value in conversion "
+ "from %qs to %qs at %L", gfc_typename (&src->ts),
+ gfc_typename (&result->ts), &src->where);
+ did_warn = true;
+ }
+ }
+ if (!did_warn && warn_conversion_extra)
+ {
+ gfc_warning_now (OPT_Wconversion_extra, "Conversion from %qs to %qs "
+ "at %L", gfc_typename (&src->ts),
+ gfc_typename (&result->ts), &src->where);
+ }
+
return result;
}
{
gfc_expr *result;
arith rc;
+ bool did_warn = false;
result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
return NULL;
}
+ /* As a special bonus, don't warn about REAL values which are not changed by
+ the conversion if -Wconversion is specified and -Wconversion-extra is
+ not. */
+
+ if ((warn_conversion || warn_conversion_extra) && src->ts.kind > kind)
+ {
+ int w = warn_conversion ? OPT_Wconversion : OPT_Wconversion_extra;
+
+ /* Calculate the difference between the constant and the rounded
+ value and check it against zero. */
+
+ if (wprecision_real_real (src->value.real, src->ts.kind, kind))
+ {
+ gfc_warning_now (w, "Change of value in conversion from "
+ "%qs to %qs at %L",
+ gfc_typename (&src->ts), gfc_typename (&result->ts),
+ &src->where);
+ /* Make sure the conversion warning is not emitted again. */
+ did_warn = true;
+ }
+ }
+
+ if (!did_warn && warn_conversion_extra)
+ gfc_warning_now (OPT_Wconversion_extra, "Conversion from %qs to %qs "
+ "at %L", gfc_typename(&src->ts),
+ gfc_typename(&result->ts), &src->where);
+
return result;
}
{
gfc_expr *result;
arith rc;
+ bool did_warn = false;
result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
return NULL;
}
+ if ((warn_conversion || warn_conversion_extra) && src->ts.kind > kind)
+ {
+ int w = warn_conversion ? OPT_Wconversion : OPT_Wconversion_extra;
+
+ if (wprecision_real_real (src->value.real, src->ts.kind, kind))
+ {
+ gfc_warning_now (w, "Change of value in conversion from "
+ "%qs to %qs at %L",
+ gfc_typename (&src->ts), gfc_typename (&result->ts),
+ &src->where);
+ /* Make sure the conversion warning is not emitted again. */
+ did_warn = true;
+ }
+ }
+
+ if (!did_warn && warn_conversion_extra)
+ gfc_warning_now (OPT_Wconversion_extra, "Conversion from %qs to %qs "
+ "at %L", gfc_typename(&src->ts),
+ gfc_typename(&result->ts), &src->where);
+
return result;
}
{
gfc_expr *result;
arith rc;
+ bool did_warn = false;
result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
return NULL;
}
+ if (warn_conversion || warn_conversion_extra)
+ {
+ int w = warn_conversion ? OPT_Wconversion : OPT_Wconversion_extra;
+
+ /* See if we discarded an imaginary part. */
+ if (mpfr_cmp_si (mpc_imagref (src->value.complex), 0) != 0)
+ {
+ gfc_warning_now (w, "Non-zero imaginary part discarded "
+ "in conversion from %qs to %qs at %L",
+ gfc_typename(&src->ts), gfc_typename (&result->ts),
+ &src->where);
+ did_warn = true;
+ }
+
+ else {
+ mpfr_t f;
+
+ mpfr_init (f);
+ mpfr_frac (f, src->value.real, GFC_RND_MODE);
+ if (mpfr_cmp_si (f, 0) != 0)
+ {
+ gfc_warning_now (w, "Change of value in conversion from "
+ "%qs to %qs at %L", gfc_typename (&src->ts),
+ gfc_typename (&result->ts), &src->where);
+ did_warn = true;
+ }
+ mpfr_clear (f);
+ }
+
+ if (!did_warn && warn_conversion_extra)
+ {
+ gfc_warning_now (OPT_Wconversion_extra, "Conversion from %qs to %qs "
+ "at %L", gfc_typename (&src->ts),
+ gfc_typename (&result->ts), &src->where);
+ }
+ }
+
return result;
}
{
gfc_expr *result;
arith rc;
+ bool did_warn = false;
result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
return NULL;
}
+ if (warn_conversion || warn_conversion_extra)
+ {
+ int w = warn_conversion ? OPT_Wconversion : OPT_Wconversion_extra;
+
+ /* See if we discarded an imaginary part. */
+ if (mpfr_cmp_si (mpc_imagref (src->value.complex), 0) != 0)
+ {
+ gfc_warning_now (w, "Non-zero imaginary part discarded "
+ "in conversion from %qs to %qs at %L",
+ gfc_typename(&src->ts), gfc_typename (&result->ts),
+ &src->where);
+ did_warn = true;
+ }
+
+ /* Calculate the difference between the real constant and the rounded
+ value and check it against zero. */
+
+ if (kind > src->ts.kind
+ && wprecision_real_real (mpc_realref (src->value.complex),
+ src->ts.kind, kind))
+ {
+ gfc_warning_now (w, "Change of value in conversion from "
+ "%qs to %qs at %L",
+ gfc_typename (&src->ts), gfc_typename (&result->ts),
+ &src->where);
+ /* Make sure the conversion warning is not emitted again. */
+ did_warn = true;
+ }
+ }
+
+ if (!did_warn && warn_conversion_extra)
+ gfc_warning_now (OPT_Wconversion, "Conversion from %qs to %qs at %L",
+ gfc_typename(&src->ts), gfc_typename (&result->ts),
+ &src->where);
+
return result;
}
{
gfc_expr *result;
arith rc;
+ bool did_warn = false;
result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
return NULL;
}
+ if ((warn_conversion || warn_conversion_extra) && src->ts.kind > kind
+ && (wprecision_real_real (mpc_realref (src->value.complex),
+ src->ts.kind, kind)
+ || wprecision_real_real (mpc_imagref (src->value.complex),
+ src->ts.kind, kind)))
+ {
+ int w = warn_conversion ? OPT_Wconversion : OPT_Wconversion_extra;
+
+ gfc_warning_now (w, "Change of value in conversion from "
+ " %qs to %qs at %L",
+ gfc_typename (&src->ts), gfc_typename (&result->ts),
+ &src->where);
+ did_warn = true;
+ }
+
+ if (!did_warn && warn_conversion_extra && src->ts.kind != kind)
+ gfc_warning_now (OPT_Wconversion_extra, "Conversion from %qs to %qs "
+ "at %L", gfc_typename(&src->ts),
+ gfc_typename (&result->ts), &src->where);
+
return result;
}
}
}
- /* 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 && 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 (OPT_Wconversion,
- "Change of value in conversion from "
- " %qs to %qs at %L", gfc_typename (&rvalue->ts),
- gfc_typename (&lvalue->ts), &rvalue->where);
-
- mpfr_clear (rv);
- mpfr_clear (diff);
- }
- else
- gfc_warning (OPT_Wconversion,
- "Possible change of value in conversion from %qs "
- "to %qs at %L", gfc_typename (&rvalue->ts),
- gfc_typename (&lvalue->ts), &rvalue->where);
-
- }
- else if (warn_conversion_extra && lvalue->ts.kind > rvalue->ts.kind)
- {
- gfc_warning (OPT_Wconversion_extra,
- "Conversion from %qs to %qs at %L",
- gfc_typename (&rvalue->ts),
- gfc_typename (&lvalue->ts), &rvalue->where);
- }
- }
-
if (gfc_compare_types (&lvalue->ts, &rvalue->ts))
return true;
/* Larger kinds can hold values of smaller kinds without problems.
Hence, only warn if target kind is smaller than the source
kind - or if -Wconversion-extra is specified. */
- if (warn_conversion && from_ts.kind > ts->kind)
- gfc_warning_now (OPT_Wconversion, "Possible change of value in "
- "conversion from %s to %s at %L",
- gfc_typename (&from_ts), gfc_typename (ts),
- &expr->where);
- else if (warn_conversion_extra)
- gfc_warning_now (OPT_Wconversion_extra, "Conversion from %s to %s "
- "at %L", gfc_typename (&from_ts),
- gfc_typename (ts), &expr->where);
+ if (expr->expr_type != EXPR_CONSTANT)
+ {
+ if (warn_conversion && from_ts.kind > ts->kind)
+ gfc_warning_now (OPT_Wconversion, "Possible change of value in "
+ "conversion from %s to %s at %L",
+ gfc_typename (&from_ts), gfc_typename (ts),
+ &expr->where);
+ else if (warn_conversion_extra)
+ gfc_warning_now (OPT_Wconversion_extra, "Conversion from %s to %s "
+ "at %L", gfc_typename (&from_ts),
+ gfc_typename (ts), &expr->where);
+ }
}
else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
|| (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
{
/* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
usually comes with a loss of information, regardless of kinds. */
- if (warn_conversion)
+ if (warn_conversion && expr->expr_type != EXPR_CONSTANT)
gfc_warning_now (OPT_Wconversion, "Possible change of value in "
"conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts),
gfc_internal_error ("gfc_range_check() returned bad value");
}
+ /* Warn about trailing digits which suggest the user added too many
+ trailing digits, which may cause the appearance of higher pecision
+ than the kind kan support.
+
+ This is done by replacing the rightmost non-zero digit with zero
+ and comparing with the original value. If these are equal, we
+ assume the user supplied more digits than intended (or forgot to
+ convert to the correct kind).
+ */
+
+ if (warn_conversion_extra)
+ {
+ mpfr_t r;
+ char *c, *p;
+ bool did_break;
+
+ c = strchr (buffer, 'e');
+ if (c == NULL)
+ c = buffer + strlen(buffer);
+
+ did_break = false;
+ for (p = c - 1; p >= buffer; p--)
+ {
+ if (*p == '.')
+ continue;
+
+ if (*p != '0')
+ {
+ *p = '0';
+ did_break = true;
+ break;
+ }
+ }
+
+ if (did_break)
+ {
+ mpfr_init (r);
+ mpfr_set_str (r, buffer, 10, GFC_RND_MODE);
+ if (negate)
+ mpfr_neg (r, r, GFC_RND_MODE);
+
+ mpfr_sub (r, r, e->value.real, GFC_RND_MODE);
+
+ if (mpfr_cmp_ui (r, 0) == 0)
+ gfc_warning (OPT_Wconversion_extra, "Non-significant digits "
+ "in %qs number at %C, maybe incorrect KIND",
+ gfc_typename (&e->ts));
+
+ mpfr_clear (r);
+ }
+ }
+
*result = e;
return MATCH_YES;
+2015-06-06 Thomas Koenig <tkoenig@netcologne.de>
+
+ PR fortran/47359
+ * gfortran.dg/array_constructor_type_17.f03: Adjust error message.
+ * gfortran.dg/warn_conversion.f90: Add warning for change in value
+ for assignment.
+ * gfortran.dg/warn_conversion_3.f90: Add warnings.
+ * gfortran.dg/warn_conversion_5.f90: New test.
+ * gfortran.dg/warn_conversion_6.f90: New test.
+ * gfortran.dg/warn_conversion_7.f90: New test.
+
2015-06-05 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/66347
IMPLICIT NONE
INTEGER(KIND=4) :: arr(1)
- arr = (/ INTEGER(KIND=4) :: HUGE(0_8) /) ! { dg-warning "conversion from" }
+ arr = (/ INTEGER(KIND=4) :: HUGE(0_8) /) ! { dg-warning "Conversion" }
END PROGRAM test
integer(kind=4) :: i4
i4 = 2.3 ! { dg-warning "conversion" }
i1 = 500 ! { dg-error "overflow" }
- a = 2**26-1 ! assignment INTEGER(4) to REAL(4) - no warning
+ a = 2**26-1 ! { dg-warning "Change of value in conversion" }
b = 1d999 ! { dg-error "overflow" }
a = i4 ! assignment INTEGER(4) to REAL(4) - no warning
complex(8), parameter :: z = cmplx (0.5, 0.5) ! { dg-warning "Conversion" }
real :: r1, r2
r1 = 2.3d0 ! { dg-warning "Change of value in conversion" }
- r2 = 2.5d0 ! No warning because the value does not change
+ r2 = 2.5d0 ! { dg-warning "Conversion" }
d1 = .13 ! { dg-warning "Conversion" }
d2 = .13d0
- d1 = z ! { dg-warning "change of value in conversion" }
+ d1 = z ! { dg-warning "Non-zero imaginary part" }
end program main
--- /dev/null
+! { dg-do compile }
+! { dg-options "-Wconversion" }
+! PR 47359 - additional warnings for conversions.
+program main
+ implicit none
+ complex(kind=4) :: c4
+ complex(kind=8) :: c8
+ real(kind=4) :: r4
+ real(kind=8) :: r8
+ complex(kind=4), parameter :: c4p = (1.0, -4.)
+ complex, parameter :: c8w = (1.0_8, -4.2_8) ! { dg-warning "Change of value in conversion" }
+ complex (kind=8), parameter :: c8p = (1.0_8, -4.2_8)
+ integer :: i
+
+ c4 = c8p ! { dg-warning "Change of value in conversion" }
+ c4 = 2**26 + 1 ! { dg-warning "Change of value in conversion" }
+ c4 = 1.3d0 ! { dg-warning "Change of value in conversion" }
+ c4 = c8p ! { dg-warning "Change of value in conversion" }
+ c4 = (1.2, 1000000001) ! { dg-warning "Change of value in conversion" }
+ r4 = (2**26 + 1) * 2.3 ! { dg-warning "Change of value in conversion" }
+ r4 = 2.4d0 ! { dg-warning "Change of value" }
+ r4 = c4p ! { dg-warning "Non-zero imaginary part" }
+ r4 = r4 + 2.3d0 ! { dg-warning "Possible change of value in conversion" }
+ r8 = 2_8**62 - 1_8 ! { dg-warning "Change of value in conversion" }
+ i = c4p ! { dg-warning "Non-zero imaginary part" }
+ i = 42 + 1.3 ! { dg-warning "Change of value in conversion" }
+ i = (1.2, 0.) ! { dg-warning "Change of value in conversion" }
+ c4 = 1.2 ! no warning
+ c4 = -3.25d0 ! no warning
+ c4 = -42 ! no warning
+ c8 = 2**26 + 1 ! no warning
+ i = 22. ! no warning
+ i = (35., 0.) ! no warning
+ r4 = 2.5d0 ! no warning
+ r4 = 235 ! no warning
+ r8 = 2.3 ! no warning
+end program main
--- /dev/null
+! { dg-do compile }
+! { dg-options "-Wconversion -Wconversion-extra" }
+! PR 47359 - additional warnings for conversions.
+program main
+ implicit none
+ real(kind=8) :: a,b
+ complex(kind=8) :: c
+ integer :: i
+ real(kind=4) :: r
+ a = 0.13 ! { dg-warning "Conversion" }
+ print *,0.1_8 ** 0.2 ! { dg-warning "Conversion" }
+ b = a/0.13 ! { dg-warning "Conversion" }
+ i = 12345. ! { dg-warning "Conversion" }
+ i = (1., 23.) ! { dg-warning "Non-zero imaginary part" }
+ r = (1., 23.) ! { dg-warning "Non-zero imaginary part" }
+ b = 0.& ! { dg-warning "Possible change of value" }
+ &5_8*c ! { dg-warning "Conversion" }
+ c = 0.3 ! { dg-warning "Conversion" }
+ a = 0.5 ! { dg-warning "Conversion" }
+end program main
+
--- /dev/null
+! { dg-do compile }
+! { dg-options "-Wconversion-extra -Wconversion" }
+program main
+ implicit none
+ double precision, parameter :: pi = & ! { dg-warning "Conversion" }
+ & 3.1415829535897932 ! { dg-warning "Non-significant digits" }
+end program main
projects / gcc.git / commitdiff