diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2018-05-19 10:49:50 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2018-05-19 10:49:50 +0000 |
commit | dc32bc72bb8ba03e66c87db9472d6067dd52d09b (patch) | |
tree | 1a59f41d667dd5435d8d2e528952bb688a13f425 /gcc | |
parent | 34dbe5e5abe67a9439a6d7fcd2ba9e76fa285d5b (diff) | |
download | gcc-dc32bc72bb8ba03e66c87db9472d6067dd52d09b.zip gcc-dc32bc72bb8ba03e66c87db9472d6067dd52d09b.tar.gz gcc-dc32bc72bb8ba03e66c87db9472d6067dd52d09b.tar.bz2 |
re PR fortran/82923 (Automatic allocation of deferred length character using function result)
2018-05-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82923
PR fortran/66694
PR fortran/82617
* trans-array.c (gfc_alloc_allocatable_for_assignment): Set the
charlen backend_decl of the rhs expr to ss->info->string_length
so that the value in the current scope is used.
2018-05-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82923
* gfortran.dg/allocate_assumed_charlen_4.f90: New test. Note
that the patch fixes PR66694 & PR82617, although the testcases
are not explicitly included.
From-SVN: r260392
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 6 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 9 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90 | 39 |
4 files changed, 61 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e1827a9..ef3d2aa 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2018-05-19 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/82923 + * gfortran.dg/allocate_assumed_charlen_4.f90: New test. Note + that the patch fixes PR66694 & PR82617, although the testcases + are not explicitly included. + 2018-05-13 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/63529 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index b68e77d..cf4b23f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -9698,6 +9698,12 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, if (expr2 && rss == gfc_ss_terminator) return NULL_TREE; + /* Ensure that the string length from the current scope is used. */ + if (expr2->ts.type == BT_CHARACTER + && expr2->expr_type == EXPR_FUNCTION + && !expr2->value.function.isym) + expr2->ts.u.cl->backend_decl = rss->info->string_length; + gfc_start_block (&fblock); /* Since the lhs is allocatable, this must be a descriptor type. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e757d80..1b4e16d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2018-05-19 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/82923 + PR fortran/66694 + PR fortran/82617 + * trans-array.c (gfc_alloc_allocatable_for_assignment): Set the + charlen backend_decl of the rhs expr to ss->info->string_length + so that the value in the current scope is used. + 2018-05-18 Kito Cheng <kito.cheng@gmail.com> * gcc.dg/stack-usage-1.c: Add support for rv32e. diff --git a/gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90 b/gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90 new file mode 100644 index 0000000..1a5539a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90 @@ -0,0 +1,39 @@ +! { dg-do run } +! +! Test the fix for PR82923, in which an ICE occurred because the +! character length from 'getchars' scope was being used in the +! automatic allocation of 'mine'. +! +! Contributed by "Werner Blokbuster" <werner.blokbuster@gmail.com> +! +module m + implicit none +contains + function getchars(my_len,my_size) + integer, intent(in) :: my_len, my_size + character(my_len) :: getchars(my_size) + getchars = 'A-' + end function getchars + + function getchars2(my_len) + integer, intent(in) :: my_len + character(my_len) :: getchars2 + getchars2 = 'B--' + end function getchars2 +end module m + +program testca + use m, only: getchars, getchars2 + implicit none + character(:), allocatable :: mine(:) + character(:), allocatable :: mine2 + integer :: i + + ! ICE occured at this line: + mine = getchars(2,4) + if (any (mine .ne. [('A-', i = 1, 4)])) stop 1 + + ! The scalar version was fine and this will keep it so: + mine2 = getchars2(3) + if (mine2 .ne. 'B--') stop 2 +end program testca |