re PR fortran/36176 (TRANSFER of constant substrings)

PR fortran/36176

	* target-memory.c (gfc_target_expr_size): Correctly treat
	substrings.
	(gfc_target_encode_expr): Likewise.
	(gfc_interpret_complex): Whitespace change.

	* gfortran.dg/transfer_simplify_9.f90: New test.

From-SVN: r135219

gcc/fortran/ChangeLog

@@ -1,3 +1,11 @@
+2008-05-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36176
+	* target-memory.c (gfc_target_expr_size): Correctly treat
+	substrings.
+	(gfc_target_encode_expr): Likewise.
+	(gfc_interpret_complex): Whitespace change.
+
 2008-05-11  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/35719

gcc/fortran/target-memory.c

@@ -100,7 +100,16 @@ 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, e->ts.kind);
+      if (e->expr_type == EXPR_SUBSTRING && e->ref)
+        {
+          int start, end;
+
+          gfc_extract_int (e->ref->u.ss.start, &start);
+          gfc_extract_int (e->ref->u.ss.end, &end);
+          return size_character (MAX(end - start + 1, 0), e->ts.kind);
+        }
+      else
+        return size_character (e->value.character.length, e->ts.kind);
     case BT_HOLLERITH:
       return e->representation.length;
     case BT_DERIVED:
@@ -231,7 +240,8 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
     return encode_array (source, buffer, buffer_size);
 
   gcc_assert (source->expr_type == EXPR_CONSTANT
-	      || source->expr_type == EXPR_STRUCTURE);
+	      || source->expr_type == EXPR_STRUCTURE
+	      || source->expr_type == EXPR_SUBSTRING);
 
   /* If we already have a target-memory representation, we use that rather 
      than recreating one.  */
@@ -257,9 +267,24 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
       return encode_logical (source->ts.kind, source->value.logical, buffer,
 			     buffer_size);
     case BT_CHARACTER:
-      return encode_character (source->ts.kind, source->value.character.length,
-			       source->value.character.string, buffer,
-			       buffer_size);
+      if (source->expr_type == EXPR_CONSTANT || source->ref == NULL)
+	return encode_character (source->ts.kind,
+				 source->value.character.length,
+			         source->value.character.string, buffer,
+			         buffer_size);
+      else
+	{
+	  int start, end;
+
+	  gcc_assert (source->expr_type == EXPR_SUBSTRING);
+	  gfc_extract_int (source->ref->u.ss.start, &start);
+	  gfc_extract_int (source->ref->u.ss.end, &end);
+	  return encode_character (source->ts.kind,
+				   MAX(end - start + 1, 0),
+				   &source->value.character.string[start-1],
+				   buffer, buffer_size);
+	}
+
     case BT_DERIVED:
       return encode_derived (source, buffer, buffer_size);
     default:
@@ -342,7 +367,8 @@ gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
 {
   int size;
   size = gfc_interpret_float (kind, &buffer[0], buffer_size, real);
-  size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, imaginary);
+  size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
+			       imaginary);
   return size;
 }
 

gcc/testsuite/ChangeLog

@@ -1,7 +1,12 @@
+2008-05-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36176
+	* gfortran.dg/transfer_simplify_9.f90: New test.
+
 2008-05-12  Paolo Carlini  <paolo.carlini@oracle.com>
 
-        PR c++/35331
-        * g++.dg/cpp0x/vt-35331.C: New.	
+	PR c++/35331
+	* g++.dg/cpp0x/vt-35331.C: New.	
 	* g++.dg/cpp0x/pr32125.C: Adjust.
 	* g++.dg/cpp0x/pr32126.C: Likewise.
 	* g++.dg/cpp0x/pr31438.C: Likewise.

gcc/testsuite/gfortran.dg/transfer_simplify_9.f90

@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! Various checks on simplification of TRANSFER of substrings
+  character(len=4), parameter :: t = "xyzt"
+  integer, parameter :: w = transfer(t,0)
+  integer :: i = 1
+  if (transfer(t,0) /= w) call abort
+  if (transfer(t(:),0) /= w) call abort
+  if (transfer(t(1:4),0) /= w) call abort
+  if (transfer(t(i:i+3),0) /= w) call abort
+
+  if (transfer(t(1:1), 0_1) /= transfer("x", 0_1)) call abort
+  if (transfer(t(2:2), 0_1) /= transfer("y", 0_1)) call abort
+  if (transfer(t(i:i), 0_1) /= transfer("x", 0_1)) call abort
+  if (transfer(t(i+1:i+1), 0_1) /= transfer("y", 0_1)) call abort
+  if (transfer(t(1:2), 0_2) /= transfer("xy", 0_2)) call abort
+  if (transfer(t(3:4), 0_2) /= transfer("zt", 0_2)) call abort
+
+  if (transfer(transfer(-1, t), 0) /= -1) call abort
+  if (transfer(transfer(-1, t(:)), 0) /= -1) call abort
+  if (any (transfer(transfer(-1, (/t(1:1)/)), (/0_1/)) /= -1)) call abort
+  if (transfer(transfer(-1, t(1:1)), 0_1) /= -1) call abort
+  end