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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ae78f0ea8af283979f66f04abaef9f92a554731f..05563105cde45d93890efe9d99bef38c53c699b4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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

diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 149afa1e8ca935b686dddec16645cf0ad6b74121..389e2a539178b416fb90da617d33eb4fb29e19e8 100644 (file)
--- a/gcc/fortran/target-memory.c
+++ b/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;
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1daba114a8a892eb22829fc5ab9a987f207c69eb..182f0494d752b58c0e19202621cf97d8e7e9e031 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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.

diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_9.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_9.f90
new file mode 100644 (file)
index 0000000..02b8611
--- /dev/null
+++ b/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