2 ! { dg-additional-options "-std=f2008 -fcheck=bounds -g -fdump-tree-original" }
3 ! { dg-output "At line 43 .*" }
4 ! { dg-shouldfail "Unequal character lengths .3/2. in ALLOCATE with SOURCE= or MOLD=" }
8 ! Test runtime checks of string length for ALLOCATE with SOURCE= or MOLD=
12 character(kind
=1,len
=2) :: c1
= "xx"
13 character(kind
=1,len
=8) :: c2
= "yy"
14 character(kind
=4,len
=6) :: c3
= 4_
"ww"
15 call sub1 (len (c2
), c2
)
16 call sub4 (len (c3
), c3
)
17 call test (len (c1
) + 1, c1
)
19 subroutine sub1 (n
, s
)
20 integer, intent(in
) :: n
21 character(*), intent(in
) :: s
22 character(len
=8), allocatable
:: f(:), g
23 character(len
=n
), allocatable
:: h(:), j
24 ALLOCATE (f(7), source
=s
)
25 ALLOCATE (g
, source
=s
)
26 ALLOCATE (h(5), mold
=s
)
29 subroutine sub4 (n
, s
)
30 integer, intent(in
) :: n
31 character(kind
=4,len
=*), intent(in
) :: s
32 character(kind
=4,len
=6), allocatable
:: f(:), g
33 character(kind
=4,len
=n
), allocatable
:: h(:), j
34 ALLOCATE (f(3), source
=s
)
35 ALLOCATE (g
, source
=s
)
36 ALLOCATE (h(5), mold
=s
)
39 subroutine test (n
, s
)
40 integer, intent(in
) :: n
41 character(*), intent(in
) :: s
42 character(len
=n
), allocatable
:: str
43 ALLOCATE (str
, source
=s
)
47 ! { dg-final { scan-tree-dump-times "__builtin_malloc .72.;" 1 "original" } }
48 ! { dg-final { scan-tree-dump-times "__builtin_malloc .24.;" 1 "original" } }
49 ! { dg-final { scan-tree-dump-times "__builtin_malloc .56.;" 1 "original" } }
50 ! { dg-final { scan-tree-dump-times "__builtin_malloc .8.;" 1 "original" } }
51 ! { dg-final { scan-tree-dump-times "ALLOCATE with SOURCE= or MOLD=" 9 "original" } }