From 3b67db31236631432e7f6d74ed49af9ae2183a4d Mon Sep 17 00:00:00 2001
From: Haochen Gui <guihaoc@gcc.gnu.org>
Date: Fri, 24 Mar 2023 10:45:52 +0800
Subject: [PATCH] Fortran: Escalate failure when Hollerith constant to real
conversion fails
gcc/fortran/
PR target/103628
* target-memory.cc (gfc_interpret_float): Return FAIL when
native_interpret_expr gets a NULL tree.
* arith.cc (gfc_hollerith2real): Return NULL when
gfc_interpret_float fails.
* error.cc (gfc_buffered_p): Define.
* gfortran.h (gfc_buffered_p): Declare.
* intrinsic.cc: Add diagnostic.h to include list.
(do_simplify): Save errorcount and check it at finish. Report a
"Cannot simplify expression" error on a bad result if error count
doesn't change and no other errors buffered.
gcc/testsuite/
PR target/103628
* gfortran.dg/assumed_size_refs_2.f90: Check "Cannot simplify
expression" error.
* gfortran.dg/unpack_field_1.f90: Likewise.
* gfortran.dg/pr103628.f90: New.
Co-Authored-By: Tobias Burnus <tobias@codesourcery.com>
---
gcc/fortran/arith.cc | 10 ++++++----
gcc/fortran/error.cc | 7 +++++++
gcc/fortran/gfortran.h | 1 +
gcc/fortran/intrinsic.cc | 9 ++++++++-
gcc/fortran/target-memory.cc | 11 +++++++----
gcc/testsuite/gfortran.dg/assumed_size_refs_2.f90 | 2 ++
gcc/testsuite/gfortran.dg/pr103628.f90 | 14 ++++++++++++++
gcc/testsuite/gfortran.dg/unpack_field_1.f90 | 2 ++
8 files changed, 47 insertions(+), 9 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr103628.f90
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 37aeaf1b186f..ddf9874671cd 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -2753,10 +2753,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. */
diff --git a/gcc/fortran/error.cc b/gcc/fortran/error.cc
index 05d3a0e1f5a6..6cae6726f91c 100644
--- a/gcc/fortran/error.cc
+++ b/gcc/fortran/error.cc
@@ -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
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9bab2c40ead3..130d5d7e5b74 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3331,6 +3331,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);
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 64821c84543d..1a26b7a571ff 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -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 */
diff --git a/gcc/fortran/target-memory.cc b/gcc/fortran/target-memory.cc
index 05b82558672d..edc30bddb529 100644
--- a/gcc/fortran/target-memory.cc
+++ b/gcc/fortran/target-memory.cc
@@ -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);
}
diff --git a/gcc/testsuite/gfortran.dg/assumed_size_refs_2.f90 b/gcc/testsuite/gfortran.dg/assumed_size_refs_2.f90
index 8eb708d49898..632b1085548b 100644
--- a/gcc/testsuite/gfortran.dg/assumed_size_refs_2.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_size_refs_2.f90
@@ -42,3 +42,5 @@ contains
end subroutine foo
end program assumed_size_test_2
+
+! { dg-error "Cannot simplify expression" " " { target *-*-* } 29 }
diff --git a/gcc/testsuite/gfortran.dg/pr103628.f90 b/gcc/testsuite/gfortran.dg/pr103628.f90
new file mode 100644
index 000000000000..255d5bdd73e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr103628.f90
@@ -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 }
diff --git a/gcc/testsuite/gfortran.dg/unpack_field_1.f90 b/gcc/testsuite/gfortran.dg/unpack_field_1.f90
index ca3cfbd2bd45..1951484f1474 100644
--- a/gcc/testsuite/gfortran.dg/unpack_field_1.f90
+++ b/gcc/testsuite/gfortran.dg/unpack_field_1.f90
@@ -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 }
--
GitLab