[Bug fortran/50069] FORALL fails on a character array

[louis.krupp at zoho dot com]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=50069

--- Comment #11 from louis.krupp at zoho dot com ---
You're right.  I wasn't paying attention to the third ("function reverse ...")
in the bug report.

I believe that's fixed with the attached patch to trans-expr.c along with my
other patch.  I no longer see the ICE, and "make check-fortran" turns up no
surprises.

I haven't tried this second patch (to trans-expr.c) by itself.

The force-forall-temp flag in the first patch isn't intended to fix anything; 
its sole purpose is to get code with obscure bugs to fail sooner, in testing,
instead of later when forall really needs to create and use a temporary under
circumstances that no one had anticipated.

Louis


 ---- On Tue, 08 Nov 2016 07:03:59 -0800 dominiq at lps dot ens.fr
<gcc-bugzilla@gcc.gnu.org> wrote ---- 
 > https://gcc.gnu.org/bugzilla/show_bug.cgi?id=50069 
 >  
 > --- Comment #10 from Dominique d'Humieres <dominiq at lps dot ens.fr> --- 
 > > The attached patch adds a slight variation of Tobias Burnus's patch 
 > > for 50069 to my patch for 55086, and it seems to fix the two tests in
50069. 
 >  
 > I have applied the patch without the last hunk. It fixes the first test by 
 > supplying the needed temporary. However compiling the test (variant of the
test 
 > in comment 6) 
 >  
 > function  reverse(string) ! bind(c, name='reverse') 
 > implicit none 
 > character(len=*), intent(in) :: string 
 > character(len=:),allocatable :: reverse 
 > integer :: i 
 > reverse = string 
 > forall (i=1:len(reverse)) reverse(i:i) = 
 > reverse(len(reverse)-i+1:len(reverse)-i+1) 
 > end function reverse 
 >  
 > still gives an ICE 
 >  
 >  forall (i=1:len(reverse)) reverse(i:i) = 
 > reverse(len(reverse)-i+1:len(reverse)-i+1) 
 >  
 > internal compiler error: in gfc_conv_variable, at fortran/trans-expr.c:2550 
 >  
 > The patch also fixes the ICE for the test reduced test from pr55086 
 >  
 >   implicit none 
 >   character(len=5), pointer :: c, d 
 >   allocate (c, d) 
 >  
 >   d = '12345' 
 >   c = "abcde" 
 >  
 >   call test2p (d, c) 
 >   print *, d 
 >   if (d /= '1cb15') stop 'WRONG' 
 >  
 > contains 
 >  subroutine test2p(o, i) 
 >   character(len=*), pointer :: o, i 
 >   integer :: nl1, nu1 
 >   integer :: i1 
 >   nl1 = 2 
 >   nu1 = 4 
 >   forall (i1 = nl1:nu1) o(i1:i1) = i(i1:i1)   ! <<<< ICE 
 >   forall (i1 = nl1:nu1) o(i1:i1) = o(nu1+1-i1:nu1+1-i1) 
 >  end subroutine test2p 
 > end 
 >  
 > but at the expense of an unneeded temporary: 
 >  
 >   { 
 >     integer(kind=4) i1.0; 
 >     integer(kind=4) D.3446; 
 >     integer(kind=8) count1.1; 
 >     integer(kind=8) num.2; 
 >     character(kind=1)[0:][1:1] * temp.4; 
 >     void * restrict D.3452; 
 >  
 >     D.3446 = nu1; 
 >     count1.1 = 0; 
 >     num.2 = 0; 
 >     { 
 >       integer(kind=4) count.3; 
 >  
 >       i1.0 = nl1; 
 >       count.3 = (1 - nl1) + nu1; 
 >       while (1) 
 >         { 
 >           if (count.3 <= 0) goto L.1; 
 >           num.2 = num.2 + 1; 
 >           i1.0 = i1.0 + 1; 
 >           count.3 = count.3 + -1; 
 >         } 
 >       L.1:; 
 >     } 
 >     D.3452 = (void * restrict) __builtin_malloc (MAX_EXPR <(unsigned long) 
 > num.2, 1>); 
 >     temp.4 = (character(kind=1)[0:][1:1] *) D.3452; 
 >     { 
 >       integer(kind=4) count.5; 
 >  
 >       i1.0 = nl1; 
 >       count.5 = (1 - nl1) + nu1; 
 >       while (1) 
 >         { 
 >           if (count.5 <= 0) goto L.2; 
 >           (*temp.4)[count1.1][1]{lb: 1 sz: 1} = (**i)[i1.0]{lb: 1 sz: 1}; 
 >           count1.1 = count1.1 + 1; 
 >           i1.0 = i1.0 + 1; 
 >           count.5 = count.5 + -1; 
 >         } 
 >       L.2:; 
 >     } 
 >     count1.1 = 0; 
 >     { 
 >       integer(kind=4) count.6; 
 >  
 >       i1.0 = nl1; 
 >       count.6 = (1 - nl1) + nu1; 
 >       while (1) 
 >         { 
 >           if (count.6 <= 0) goto L.3; 
 >           (**o)[i1.0]{lb: 1 sz: 1} = (*temp.4)[count1.1][1]{lb: 1 sz: 1}; 
 >           count1.1 = count1.1 + 1; 
 >           i1.0 = i1.0 + 1; 
 >           count.6 = count.6 + -1; 
 >         } 
 >       L.3:; 
 >     } 
 >     __builtin_free ((void *) temp.4); 
 >   } 
 >  
 > --  
 > You are receiving this mail because: 
 > You are on the CC list for the bug.