[fortran] PR82923 - Automatic allocation of deferred length character using function result

Message ID CAGkQGiKrr8bNKxyVA7NnHgeoSz3_GQVRgfSFC3nY31D5kSKTcQ@mail.gmail.com
State New
Headers show
Series
  • [fortran] PR82923 - Automatic allocation of deferred length character using function result
Related show

Commit Message

Paul Richard Thomas May 17, 2018, 12:17 p.m.
The ChangeLog and the comments in the patch tell all.

Bootstrapped and regtested on FC27/x86_64.

OK for 7-branch through to trunk?

Paul

2018-05-17  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/82923
    * 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-17  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/82923
    * gfortran.dg/allocate_assumed_charlen_4.f90: New test.

Patch

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 260210)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_alloc_allocatable_for_assignment (gf
*** 9698,9703 ****
--- 9698,9709 ----
    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.
Index: gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90	(working copy)
***************
*** 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 allocataion 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