1! { dg-do run }
2! PR fortran/36795
3! "(str)" (= an expression) was regarded as "str" (= a variable)
4! and thus when yy was deallocated so was xx. Result: An invalid
5! memory access.
6!
7program main
8  implicit none
9  character (len=10), allocatable :: str(:)
10  allocate (str(1))
11  str(1)      = "dog"
12  if (size(str) /= 1 .or. str(1) /= "dog") call abort()
13contains
14  subroutine foo(xx,yy)
15    character (len=*), intent(in)               :: xx(:)
16    character (len=*), intent(out), allocatable :: yy(:)
17    allocate (yy(size(xx)))
18    yy = xx
19  end subroutine foo
20end program main
21