This is the mail archive of the mailing list for the GCC project.

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch, fortran] A partial fix for PR31610 (ICE with transfer)

:ADDPATCH fortran:

PR 31610 is turning out to be a real bear to fix, despite being essentially a one-line testcase. This patch fixes three (!) somewhat independent problems that were causing it to fail, but there's still more to go -- and I'd appreciate some advice on the remainder from someone who knows the scalarizer fairly well; I'm just about stuck; see the PR for details. (Though Andrew Pinski mentioned to me that PR 31608 seems related, so I'll try poking at that next.)

The first solved problem is that, if the mold argument to transfer is an uninitialized variable, then it doesn't have a value, and gfc_target_expr_size ICEs when trying to access e->value.character.length. That's easy enough to fix; this checks the typespec for a length first, and then uses the value length if that doesn't exist.

The second problem is that, if the source argument to transfer is an EXPR_FUNCTION expression and gfc_is_constant_expr(source) is true, we try to simplify it. This does not work, and quickly leads to an ICE. I fixed that by returning NULL unless source is an EXPR_ARRAY, EXPR_CONSTANT, or EXPR_STRUCTURE expression.

The third problem is that, when the result is a character array and the mold is a character scalar, we also get an ICE. The problem here is that a character array expression needs to have a that's non-NULL, otherwise we get an ICE when the trans-* part of the front end tries to set parts of it. However, when we're transferring something to a character array, we currently don't bother creating result-> If the mold is a character array, we'll get a copy of mold-> and then things work, but if the mold is a character scalar without a, then we have problems.

A related issue is that, when I initially wrote this, I set the result->value.character.length value to pass the character length to the gfc_target_interpret_expr function, even though character arrays aren't supposed to have values directly. Correcting that to do things "right" by creating a result-> if it doesn't exist, and putting the character length in>length where it should be, fixes this particular bug.

Oh, and a fourth problem that this patch fixes: If the result is larger than the source, we end up accessing uninitialized parts of the buffer. I fixed this by memsetting the buffer to zero when it's created, though (since the padding is specified as "machine dependent" rather than zero) it might be more appropriate to use something else to avoid giving people a false sense of security.

2007-05-28  Brooks Moses  <>

	PR fortran/31610
	* target-memory.c (size_character): Check for the typespec
	length as well as the value length.
	(gfc_target_expr_size): Pass the whole expression to
	(encode_character): Check the buffer size against the
	length directly.
	(interpret_array): Use the typespec length, not the value
	length, for character array result expressions.
	(gfc_interpret_character): Pass the whole result to
	* simplify.c (gfc_simplify_transfer): Only simplify if
	arguments are ARRAY, STRUCTURE, or CONSTANT.  Pass character
	lengths for array results in>length, not in
	value.character.length.  Set the buffer to zero before use,
	to avoid accessing uninitialized memory.

2007-05-28  Brooks Moses  <>

	PR fortran/31610
	* gfortran.dg/transfer_simplify_5.f90: New test.


Regression-tested on powerpc-apple-darwin8.9.0. Ok for trunk?

- Brooks
Index: target-memory.c
--- target-memory.c	(revision 125141)
+++ target-memory.c	(working copy)
@@ -74,9 +74,16 @@ size_logical (int kind)
 static size_t
-size_character (int length)
+size_character (gfc_expr *e)
-  return length;
+  /* Return the typespec length, if it exists.  */
+  if (e-> != NULL && e->>length != NULL
+      && e->>length->expr_type == EXPR_CONSTANT
+      && e->>length->ts.type == BT_INTEGER)
+    return (int)mpz_get_ui (e->>length->value.integer);
+  /* Otherwise, return the constructor length.  */
+  return e->value.character.length;
@@ -101,7 +108,7 @@ gfc_target_expr_size (gfc_expr *e)
     case BT_LOGICAL:
       return size_logical (e->ts.kind);
     case BT_CHARACTER:
-      return size_character (e->value.character.length);
+      return size_character (e);
     case BT_HOLLERITH:
       return e->representation.length;
     case BT_DERIVED:
@@ -178,7 +185,7 @@ static int
 encode_character (int length, char *string, unsigned char *buffer,
 		  size_t buffer_size)
-  gcc_assert (buffer_size >= size_character (length));
+  gcc_assert (buffer_size >= (size_t) length);
   memcpy (buffer, string, length);
   return length;
@@ -289,7 +296,8 @@ interpret_array (unsigned char *buffer, 
       tail->expr->ts = result->ts;
       if (tail->expr->ts.type == BT_CHARACTER)
-	tail->expr->value.character.length = result->value.character.length;
+	tail->expr->value.character.length
+	  = (int)mpz_get_ui (result->>length->value.integer);
       ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
@@ -355,7 +363,7 @@ gfc_interpret_character (unsigned char *
     result->value.character.length =
       (int)mpz_get_ui (result->>length->value.integer);
-  gcc_assert (buffer_size >= size_character (result->value.character.length));
+  gcc_assert (buffer_size >= size_character (result));
   result->value.character.string =
     gfc_getmem (result->value.character.length + 1);
   memcpy (result->value.character.string, buffer,
Index: simplify.c
--- simplify.c	(revision 125106)
+++ simplify.c	(working copy)
@@ -3875,8 +3875,15 @@ gfc_simplify_transfer (gfc_expr *source,
   mpz_t tmp;
   unsigned char *buffer;
-  if (!gfc_is_constant_expr (source)
-	|| !gfc_is_constant_expr (size))
+  if ((source->expr_type != EXPR_ARRAY && source->expr_type != EXPR_CONSTANT
+       && source->expr_type != EXPR_STRUCTURE)
+      || !gfc_is_constant_expr (source))
+    return NULL;
+  if (size && ((size->expr_type != EXPR_ARRAY
+		&& size->expr_type != EXPR_CONSTANT
+		&& size->expr_type != EXPR_STRUCTURE)
+	       || !gfc_is_constant_expr (size)))
     return NULL;
   /* Calculate the size of the source.  */
@@ -3895,13 +3902,8 @@ gfc_simplify_transfer (gfc_expr *source,
 		 ? mold->value.constructor->expr
 		 : mold;
-  /* Set result character length, if needed.  Note that this needs to be
-     set even for array expressions, in order to pass this information into 
-     gfc_target_interpret_expr.  */
-  if (result->ts.type == BT_CHARACTER)
-    result->value.character.length = mold_element->value.character.length;
-  /* Set the number of elements in the result, and determine its size.  */
+  /* Set the number of elements in the result, determine its size,
+     and set the character length if needed.  */
   result_elt_size = gfc_target_expr_size (mold_element);
   if (mold->expr_type == EXPR_ARRAY || size)
@@ -3923,16 +3925,32 @@ gfc_simplify_transfer (gfc_expr *source,
       mpz_init_set_ui (result->shape[0], result_length);
       result_size = result_length * result_elt_size;
+      if (result->ts.type == BT_CHARACTER && result-> == NULL)
+	{
+	  result-> = gfc_get_charlen();
+          result->>next = gfc_current_ns->cl_list;
+          gfc_current_ns->cl_list = result->;
+	  result->>length
+	    = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
+				   &source->where);
+	  mpz_init_set_ui (result->>length->value.integer,
+			   mold_element->value.character.length);
+	}
       result->rank = 0;
       result_size = result_elt_size;
+      if (result->ts.type == BT_CHARACTER)
+	result->value.character.length = mold_element->value.character.length;
   /* Allocate the buffer to store the binary version of the source.  */
   buffer_size = MAX (source_size, result_size);
   buffer = (unsigned char*)alloca (buffer_size);
+  memset (buffer, 0, buffer_size);
   /* Now write source to the buffer.  */
   gfc_target_encode_expr (source, buffer, buffer_size);
! { dg-do compile }
! Various problems found in solving PR 31610:

  character :: c

! Check that the length of an uninitialized scalar is handled
! properly.
  write(*,*) transfer("ab", c)

! Check that we don't have problems with constant function arguments.
  write(*,*) transfer (merge ( (/ "a", "b" /), "c", (/ .true., .false. /) ), &
    "ac" )

! Check that character lengths get set correctly when the result
! is an array and the mold is a scalar.
  write(*,*) transfer("ABCDE", "x", 5)

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]