diff mbox series

[PR,fortran/89266] - ICE with TRANSFER of len=0 character array constructor

Message ID 5C6B3642.8000306@gmx.de
State New
Headers show
Series [PR,fortran/89266] - ICE with TRANSFER of len=0 character array constructor | expand

Commit Message

Harald Anlauf Feb. 18, 2019, 10:48 p.m. UTC 
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  <anlauf@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  <anlauf@gmx.de>

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

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

Comments

Thomas Koenig Feb. 23, 2019, 6:10 p.m. UTC | #1 
Hi Harald,

> OK for trunk?  Or rather wait for post-9.1?

I think this can go into current trunk.

Thanks!

Regards

	Thomas
Harald Anlauf Feb. 24, 2019, 8:08 p.m. UTC | #2 
Committed as rev. 269177.  As this patch also fixed PR88326,
I added the testcase below.

Thanks for the review,
Harald

2019-02-24  Harald Anlauf  <anlauf@gmx.de>

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

On 02/23/19 19:10, Thomas Koenig wrote:
> Hi Harald,
> 
>> OK for trunk?  Or rather wait for post-9.1?
> 
> I think this can go into current trunk.
> 
> Thanks!
> 
> Regards
> 
>     Thomas
>
Index: gcc/testsuite/gfortran.dg/pr88326.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr88326.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr88326.f90	(working copy)
@@ -0,0 +1,11 @@
+! { 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
diff mbox series

Patch

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