+2019-02-24 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/89266
+ PR fortran/88326
+ * 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-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/84387
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)
{
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;
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,
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. */
{
gfc_expr *result = NULL;
mpz_t array_size;
+ size_t res_size;
if (x->ts.type == BT_CLASS || x->ts.deferred)
return NULL;
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;
}
{
gfc_expr *result = NULL;
int k;
+ size_t siz;
if (x->ts.type == BT_CLASS || x->ts.deferred)
return NULL;
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");
/* 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;
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)
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:
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;
}
/* 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);
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);
/* 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 *,
+2019-02-24 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/89266
+ PR fortran/88326
+ * gfortran.dg/pr89266.f90: New test.
+ * gfortran.dg/pr88326.f90: New test.
+
2019-02-24 Jakub Jelinek <jakub@redhat.com>
PR rtl-optimization/89445
--- /dev/null
+! { dg-do compile }
+!
+! PR fortran/88326 - ICE in gfc_conv_array_initializer
+
+program p
+ character, parameter :: x(3) = ['a','b','c']
+ character :: y(1) = transfer('', x) ! { dg-error "Different shape for array assignment" }
+ character(0) :: z(1) = transfer('', x) ! { dg-error "Different shape for array assignment" }
+ character :: u(0) = transfer('', x)
+ print *, y, z, u
+end
--- /dev/null
+! { 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
git://gcc.gnu.org / gcc.git / commitdiff