The issue in the PR is caused during simplification in the frontend
because it does not properly differentiate between expressions of
size 0 (e.g. arrays of length 0 or character strings of len=0)
and failure.
The attached patch tries to solve this problem by modifying the
helper functions gfc_element_size and gfc_target_expr_size to
return a bool when simplification fails. All users of these
functions needed adjustment, most of which was more or less
mechanical.
There was one case left (in check.c) where I am unsure if I got
the logic right. In the worst case it should produce a new bug
for code that would have generated an ICE before.
Since the above fix also works for non-character arrays of length 0,
I added a suitable test.
Regtested on x86_64-pc-linux-gnu.
OK for trunk? Or rather wait for post-9.1?
Thanks,
Harald
2019-02-18 Harald Anlauf <anl...@gmx.de>
PR fortran/89266
* target-memory.c (gfc_element_size): Return false if element size
cannot be determined; element size is returned separately.
(gfc_target_expr_size): Return false if expression size cannot be
determined; expression size is returned separately.
* target-memory.h: Adjust prototypes.
* check.c (gfc_calculate_transfer_sizes): Adjust references to
gfc_target_expr_size, gfc_element_size.
* arith.c (hollerith2representation): Likewise.
* class.c (find_intrinsic_vtab): Likewise.
* simplify.c (gfc_simplify_sizeof): Likewise.
2019-02-18 Harald Anlauf <anl...@gmx.de>
PR fortran/89266
* gfortran.dg/pr89266.f90: New test.
Index: gcc/fortran/arith.c
===================================================================
--- gcc/fortran/arith.c (revision 268993)
+++ gcc/fortran/arith.c (working copy)
@@ -2548,10 +2548,10 @@
static void
hollerith2representation (gfc_expr *result, gfc_expr *src)
{
- int src_len, result_len;
+ size_t src_len, result_len;
src_len = src->representation.length - src->ts.u.pad;
- result_len = gfc_target_expr_size (result);
+ gfc_target_expr_size (result, &result_len);
if (src_len > result_len)
{
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 268993)
+++ gcc/fortran/check.c (working copy)
@@ -5480,16 +5480,15 @@
return false;
/* Calculate the size of the source. */
- *source_size = gfc_target_expr_size (source);
- if (*source_size == 0)
+ if (!gfc_target_expr_size (source, source_size))
return false;
/* Determine the size of the element. */
- result_elt_size = gfc_element_size (mold);
- if (result_elt_size == 0)
+ if (!gfc_element_size (mold, &result_elt_size))
return false;
- if (mold->expr_type == EXPR_ARRAY || mold->rank || size)
+ if ((result_elt_size > 0 && (mold->expr_type == EXPR_ARRAY || mold->rank))
+ || size)
{
int result_length;
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c (revision 268993)
+++ gcc/fortran/class.c (working copy)
@@ -2666,6 +2666,7 @@
gfc_namespace *sub_ns;
gfc_namespace *contained;
gfc_expr *e;
+ size_t e_size;
gfc_get_symbol (name, ns, &vtype);
if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL,
@@ -2700,11 +2701,13 @@
e = gfc_get_expr ();
e->ts = *ts;
e->expr_type = EXPR_VARIABLE;
+ if (ts->type == BT_CHARACTER)
+ e_size = ts->kind;
+ else
+ gfc_element_size (e, &e_size);
c->initializer = gfc_get_int_expr (gfc_size_kind,
NULL,
- ts->type == BT_CHARACTER
- ? ts->kind
- : gfc_element_size (e));
+ e_size);
gfc_free_expr (e);
/* Add component _extends. */
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (revision 268993)
+++ gcc/fortran/simplify.c (working copy)
@@ -7379,6 +7379,7 @@
{
gfc_expr *result = NULL;
mpz_t array_size;
+ size_t res_size;
if (x->ts.type == BT_CLASS || x->ts.deferred)
return NULL;
@@ -7394,7 +7395,8 @@
result = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind,
&x->where);
- mpz_set_si (result->value.integer, gfc_target_expr_size (x));
+ gfc_target_expr_size (x, &res_size);
+ mpz_set_si (result->value.integer, res_size);
return result;
}
@@ -7408,6 +7410,7 @@
{
gfc_expr *result = NULL;
int k;
+ size_t siz;
if (x->ts.type == BT_CLASS || x->ts.deferred)
return NULL;
@@ -7423,7 +7426,8 @@
result = gfc_get_constant_expr (BT_INTEGER, k, &x->where);
- mpz_set_si (result->value.integer, gfc_element_size (x));
+ gfc_element_size (x, &siz);
+ mpz_set_si (result->value.integer, siz);
mpz_mul_ui (result->value.integer, result->value.integer, BITS_PER_UNIT);
return range_check (result, "STORAGE_SIZE");
Index: gcc/fortran/target-memory.c
===================================================================
--- gcc/fortran/target-memory.c (revision 268993)
+++ gcc/fortran/target-memory.c (working copy)
@@ -73,10 +73,10 @@
/* Return the size of a single element of the given expression.
- Identical to gfc_target_expr_size for scalars. */
+ Equivalent to gfc_target_expr_size for scalars. */
-size_t
-gfc_element_size (gfc_expr *e)
+bool
+gfc_element_size (gfc_expr *e, size_t *siz)
{
tree type;
@@ -83,16 +83,20 @@
switch (e->ts.type)
{
case BT_INTEGER:
- return size_integer (e->ts.kind);
+ *siz = size_integer (e->ts.kind);
+ return true;
case BT_REAL:
- return size_float (e->ts.kind);
+ *siz = size_float (e->ts.kind);
+ return true;
case BT_COMPLEX:
- return size_complex (e->ts.kind);
+ *siz = size_complex (e->ts.kind);
+ return true;
case BT_LOGICAL:
- return size_logical (e->ts.kind);
+ *siz = size_logical (e->ts.kind);
+ return true;
case BT_CHARACTER:
if (e->expr_type == EXPR_CONSTANT)
- return size_character (e->value.character.length, e->ts.kind);
+ *siz = size_character (e->value.character.length, e->ts.kind);
else if (e->ts.u.cl != NULL && e->ts.u.cl->length != NULL
&& e->ts.u.cl->length->expr_type == EXPR_CONSTANT
&& e->ts.u.cl->length->ts.type == BT_INTEGER)
@@ -100,13 +104,18 @@
HOST_WIDE_INT length;
gfc_extract_hwi (e->ts.u.cl->length, &length);
- return size_character (length, e->ts.kind);
+ *siz = size_character (length, e->ts.kind);
}
else
- return 0;
+ {
+ *siz = 0;
+ return false;
+ }
+ return true;
case BT_HOLLERITH:
- return e->representation.length;
+ *siz = e->representation.length;
+ return true;
case BT_DERIVED:
case BT_CLASS:
case BT_VOID:
@@ -120,36 +129,43 @@
type = gfc_typenode_for_spec (&ts);
size = int_size_in_bytes (type);
gcc_assert (size >= 0);
- return size;
+ *siz = size;
}
+ return true;
default:
gfc_internal_error ("Invalid expression in gfc_element_size.");
- return 0;
+ *siz = 0;
+ return false;
}
+ return true;
}
/* Return the size of an expression in its target representation. */
-size_t
-gfc_target_expr_size (gfc_expr *e)
+bool
+gfc_target_expr_size (gfc_expr *e, size_t *size)
{
mpz_t tmp;
- size_t asz;
+ size_t asz, el_size;
gcc_assert (e != NULL);
+ *size = 0;
if (e->rank)
{
if (gfc_array_size (e, &tmp))
asz = mpz_get_ui (tmp);
else
- asz = 0;
+ return false;
}
else
asz = 1;
- return asz * gfc_element_size (e);
+ if (!gfc_element_size (e, &el_size))
+ return false;
+ *size = asz * el_size;
+ return true;
}
@@ -675,7 +691,7 @@
/* Otherwise, use the target-memory machinery to write a bitwise image,
appropriate
to the target, in a buffer and check off the initialized part of the
buffer. */
- len = gfc_target_expr_size (e);
+ gfc_target_expr_size (e, &len);
buffer = (unsigned char*)alloca (len);
len = gfc_target_encode_expr (e, buffer, len);
@@ -722,8 +738,10 @@
for (c = gfc_constructor_first (e->value.constructor);
c; c = gfc_constructor_next (c))
{
- size_t elt_size = gfc_target_expr_size (c->expr);
+ size_t elt_size;
+ gfc_target_expr_size (c->expr, &elt_size);
+
if (mpz_cmp_si (c->offset, 0) != 0)
len = elt_size * (size_t)mpz_get_si (c->offset);
Index: gcc/fortran/target-memory.h
===================================================================
--- gcc/fortran/target-memory.h (revision 268993)
+++ gcc/fortran/target-memory.h (working copy)
@@ -24,8 +24,8 @@
/* Convert a BOZ to REAL or COMPLEX. */
bool gfc_convert_boz (gfc_expr *, gfc_typespec *);
-size_t gfc_element_size (gfc_expr *);
-size_t gfc_target_expr_size (gfc_expr *);
+bool gfc_element_size (gfc_expr *, size_t *);
+bool gfc_target_expr_size (gfc_expr *, size_t *);
/* Write a constant expression in binary form to a target buffer. */
size_t gfc_encode_character (int, size_t, const gfc_char_t *, unsigned char *,
Index: gcc/testsuite/gfortran.dg/pr89266.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr89266.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr89266.f90 (working copy)
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! PR fortran/89266 - ICE with TRANSFER of len=0 character array constructor
+
+program test
+ implicit none
+ character(*), parameter :: n = ''
+ character(*), parameter :: o = transfer ([''], n)
+ character(*), parameter :: p = transfer ( n , n)
+ character(*), parameter :: q = transfer ([n], n)
+ character(6), save :: r = transfer ([''], n)
+ character(6), save :: s = transfer ( n , n)
+ character(6), save :: t = transfer ([n], n)
+ integer, parameter :: a(0) = 0
+ integer, parameter :: b(0) = transfer (a, a)
+ integer, save :: c(0) = transfer (a, a)
+ if (len (o) /= 0) stop 1
+ if (len (p) /= 0) stop 2
+ if (len (q) /= 0) stop 3
+ if (r /= "") stop 4
+ if (s /= "") stop 5
+ if (t /= "") stop 6
+ if (size (b) /= 0 .or. any (b /= 0)) stop 7
+ if (size (c) /= 0 .or. any (c /= 0)) stop 8
+end program test
