@@ -2752,10 +2752,12 @@ gfc_hollerith2real (gfc_expr *src, int kind)
result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
hollerith2representation (result, src);
- gfc_interpret_float (kind, (unsigned char *) result->representation.string,
- result->representation.length, result->value.real);
-
- return result;
+ if (gfc_interpret_float (kind,
+ (unsigned char *) result->representation.string,
+ result->representation.length, result->value.real))
+ return result;
+ else
+ return NULL;
}
/* Convert character to real. The constant will be padded or truncated. */
@@ -49,6 +49,13 @@ static gfc_error_buffer error_buffer;
static output_buffer *pp_error_buffer, *pp_warning_buffer;
static int warningcount_buffered, werrorcount_buffered;
+/* Return buffered_p. */
+bool
+gfc_buffered_p (void)
+{
+ return buffered_p;
+}
+
/* Return true if there output_buffer is empty. */
static bool
@@ -3328,6 +3328,7 @@ void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC
void gfc_clear_error (void);
bool gfc_error_check (void);
bool gfc_error_flag_test (void);
+bool gfc_buffered_p (void);
notification gfc_notification_std (int);
bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see
#include "options.h"
#include "gfortran.h"
#include "intrinsic.h"
+#include "diagnostic.h" /* For errorcount. */
/* Namespace to hold the resolved symbols for intrinsic subroutines. */
static gfc_namespace *gfc_intrinsic_namespace;
@@ -4620,6 +4621,7 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
{
gfc_expr *result, *a1, *a2, *a3, *a4, *a5, *a6;
gfc_actual_arglist *arg;
+ int old_errorcount = errorcount;
/* Max and min require special handling due to the variable number
of args. */
@@ -4708,7 +4710,12 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
finish:
if (result == &gfc_bad_expr)
- return false;
+ {
+ if (errorcount == old_errorcount
+ && (!gfc_buffered_p () && !gfc_error_flag_test ()))
+ gfc_error ("Cannot simplify expression at %L", &e->where);
+ return false;
+ }
if (result == NULL)
resolve_intrinsic (specific, e); /* Must call at run-time */
@@ -416,11 +416,14 @@ gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
mpfr_t real)
{
gfc_set_model_kind (kind);
- mpfr_init (real);
- gfc_conv_tree_to_mpfr (real,
- native_interpret_expr (gfc_get_real_type (kind),
- buffer, buffer_size));
+ tree source = native_interpret_expr (gfc_get_real_type (kind), buffer,
+ buffer_size);
+ if (!source)
+ return 0;
+
+ mpfr_init (real);
+ gfc_conv_tree_to_mpfr (real, source);
return size_float (kind);
}
@@ -42,3 +42,5 @@ contains
end subroutine foo
end program assumed_size_test_2
+
+! { dg-error "Cannot simplify expression" " " { target *-*-* } 29 }
new file mode 100644
@@ -0,0 +1,14 @@
+! { dg-do compile { target powerpc*-*-* } }
+! { dg-options "-O2 -mabi=ibmlongdouble" }
+
+! Test to ensure that it reports an "Cannot simplify expression" error
+! instead of throwing an ICE when the memory represent of the HOLLERITH
+! string is not unique with ibm long double encoding.
+
+program main
+ integer, parameter :: k = 16
+ real(kind = k):: b = 4h1234
+end program main
+
+! { dg-warning "Conversion from HOLLERITH" "warning" { target powerpc*-*-* } 10 }
+! { dg-error "Cannot simplify expression" "error" { target powerpc*-*-* } 10 }
@@ -13,3 +13,5 @@ program p
print *, unpack(a,mask,d) ! OK
print *, unpack(a,mask,3) ! OK
end
+
+! { dg-error "Cannot simplify expression" " " { target *-*-* } 12 }