re PR fortran/34080 (Transfer was working, now broken)
authorPaul Thomas <pault@gcc.gnu.org>
Tue, 13 Nov 2007 20:33:21 +0000 (20:33 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Tue, 13 Nov 2007 20:33:21 +0000 (20:33 +0000)
2007-11-13  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/34080
* iresolve.c (gfc_resolve_transfer): Do not try to convert
to a constant MOLD expression, if it is an assumed size
dummy.

2007-11-13  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/34080
* gfortran.dg/transfer_assumed_size_1.f90: New test.

From-SVN: r130158

gcc/fortran/ChangeLog
gcc/fortran/iresolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/transfer_assumed_size_1.f90 [new file with mode: 0644]

index 4983be7..27fc761 100644 (file)
@@ -1,3 +1,10 @@
+2007-11-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/34080
+       * iresolve.c (gfc_resolve_transfer): Do not try to convert
+       to a constant MOLD expression, if it is an assumed size
+       dummy.
+
 2007-11-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        * trans-common.c: Remove prototype for gfc_get_common.
index 6de83ee..4a54963 100644 (file)
@@ -2283,7 +2283,8 @@ gfc_resolve_transfer (gfc_expr *f, gfc_expr *source ATTRIBUTE_UNUSED,
   /* TODO: Make this do something meaningful.  */
   static char transfer0[] = "__transfer0", transfer1[] = "__transfer1";
 
-  if (mold->ts.type == BT_CHARACTER && !mold->ts.cl->length)
+  if (mold->ts.type == BT_CHARACTER && !mold->ts.cl->length
+       && !(mold->expr_type == EXPR_VARIABLE && mold->symtree->n.sym->attr.dummy))
     mold->ts.cl->length = gfc_int_expr (mold->value.character.length);
 
   f->ts = mold->ts;
index f4337d2..57dbf78 100644 (file)
@@ -1,3 +1,8 @@
+2007-11-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/34080
+       * gfortran.dg/transfer_assumed_size_1.f90: New test.
+
 2007-11-13  Jakub Jelinek  <jakub@redhat.com>
 
        PR c++/34054
diff --git a/gcc/testsuite/gfortran.dg/transfer_assumed_size_1.f90 b/gcc/testsuite/gfortran.dg/transfer_assumed_size_1.f90
new file mode 100644 (file)
index 0000000..f423188
--- /dev/null
@@ -0,0 +1,45 @@
+! { dg-do run }
+! Tests the fix for the regression PR34080, in which the character
+! length of the assumed length arguments to TRANSFER were getting
+! lost.
+!
+! Drew McCormack <drewmccormack@mac.com>
+!
+module TransferBug
+   type ByteType
+      private
+      character(len=1)                                  :: singleByte
+   end type
+
+   type (ByteType), save                                :: BytesPrototype(1)
+
+contains
+
+   function StringToBytes(v) result (bytes)
+      character(len=*), intent(in)                      :: v
+      type (ByteType)                                   :: bytes(size(transfer(v, BytesPrototype)))
+      bytes = transfer(v, BytesPrototype)
+   end function
+
+   subroutine BytesToString(bytes, string)
+      type (ByteType), intent(in)                       :: bytes(:)
+      character(len=*), intent(out)                     :: string
+      character(len=1)                                  :: singleChar(1)
+      integer                                           :: numChars
+      numChars = size(transfer(bytes,singleChar))
+      string = ''
+      string = transfer(bytes, string)
+      string(numChars+1:) = ''
+   end subroutine
+
+end module
+
+
+program main
+   use TransferBug
+   character(len=100) :: str
+   call BytesToString( StringToBytes('Hi'), str )
+   if (trim(str) .ne. "Hi") call abort ()
+end program
+! { dg-final { cleanup-modules "TransferBug" } }
+