re PR fortran/89266 (ICE with TRANSFER of len=0 character array constructor)

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.

	PR fortran/89266
	PR fortran/88326
	* gfortran.dg/pr89266.f90: New test.
	* gfortran.dg/pr88326.f90: New test.

From-SVN: r269177

7 files changed, 73 insertions, 34 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 580d4b7..db151a8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+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
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 425345c..52d3a38 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -2548,10 +2548,10 @@ gfc_character2character (gfc_expr *src, int kind)
 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)
     {
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index c60de6b..0367c92 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -5480,16 +5480,15 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size,
     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;
 
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index bcbe631..3f23556 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -2674,6 +2674,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
 	      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,
@@ -2708,11 +2709,13 @@ find_intrinsic_vtab (gfc_typespec *ts)
 	      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.  */
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 942f2ee..6c1f4bd 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -7383,6 +7383,7 @@ gfc_simplify_sizeof (gfc_expr *x)
 {
   gfc_expr *result = NULL;
   mpz_t array_size;
+  size_t res_size;
 
   if (x->ts.type == BT_CLASS || x->ts.deferred)
     return NULL;
@@ -7398,7 +7399,8 @@ gfc_simplify_sizeof (gfc_expr *x)
 
   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;
 }
@@ -7412,6 +7414,7 @@ gfc_simplify_storage_size (gfc_expr *x,
 {
   gfc_expr *result = NULL;
   int k;
+  size_t siz;
 
   if (x->ts.type == BT_CLASS || x->ts.deferred)
     return NULL;
@@ -7427,7 +7430,8 @@ gfc_simplify_storage_size (gfc_expr *x,
 
   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");
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 69879c2..09af2a5 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -73,26 +73,30 @@ size_character (gfc_charlen_t length, int kind)
 
 
 /* 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)
@@ -100,13 +104,18 @@ gfc_element_size (gfc_expr *e)
 	  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 @@ gfc_element_size (gfc_expr *e)
 	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 @@ expr_to_char (gfc_expr *e, locus *loc,
 
   /* 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,7 +738,9 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, locus *loc,
       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);
diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h
index 37ac22f..5e06c9a 100644
--- a/gcc/fortran/target-memory.h
+++ b/gcc/fortran/target-memory.h
@@ -24,8 +24,8 @@ along with GCC; see the file COPYING3.  If not see
 /* 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 *,