1! { dg-do compile }
2! { dg-options "-O3" }
3!
4! Tests the fix for PR85954 in which the gimplifier could not determine
5! the space required for the dummy argument data types, when inlining the
6! subroutines.
7!
8! Contributed by G.Steinmetz  <gscfq@t-online.de>
9!
10program p
11   character(kind=1,len=:), allocatable :: z(:)
12   allocate (z, source = ["xyz"])
13   print *, allocated(z), size(z), len(z), z
14   call s(z)
15   call t(z)
16contains
17   subroutine s(x)
18      character(kind=1,len=:), allocatable :: x(:)
19      x = ['abcd']
20      print *, allocated(x), size(x), len(x), x
21   end
22   subroutine t(x)
23      character(kind=1,len=:), allocatable :: x(:)
24      associate (y => x)
25         y = ['abc']
26      end associate
27      print *, allocated(x), size(x), len(x), x
28   end
29end
30