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

gcc/fortran/ChangeLog

+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

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)
     {

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;
 

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.  */

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");

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);

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 *,

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/pr88326.f90

+! { 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

gcc/testsuite/gfortran.dg/pr89266.f90

+! { 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