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

[dominiq at lps dot ens.fr]

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);
  }