From f1c4b4239ec38a7f1fdba3b905c2bd6bb56206a3 Mon Sep 17 00:00:00 2001 From: pault Date: Tue, 13 Nov 2007 20:33:21 +0000 Subject: [PATCH] 2007-11-13 Paul Thomas 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 PR fortran/34080 * gfortran.dg/transfer_assumed_size_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130158 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/iresolve.c | 3 +- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/transfer_assumed_size_1.f90 | 45 ++++++++++++++++++++++ 4 files changed, 59 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/transfer_assumed_size_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4983be7..27fc761 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-11-13 Paul Thomas + + 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 * trans-common.c: Remove prototype for gfc_get_common. diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 6de83ee..4a54963 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f4337d28..57dbf78 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-11-13 Paul Thomas + + PR fortran/34080 + * gfortran.dg/transfer_assumed_size_1.f90: New test. + 2007-11-13 Jakub Jelinek 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 index 0000000..f423188 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_assumed_size_1.f90 @@ -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 +! +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" } } + -- 2.7.4