|
111
|
1 ! { dg-do compile }
|
|
|
2 ! Tests the fix for PR29387, in which array valued arguments of
|
|
|
3 ! LEN and ASSOCIATED would cause an ICE.
|
|
|
4 !
|
|
|
5 ! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
|
|
6 !
|
|
|
7 integer :: ans
|
|
|
8 TYPE T1
|
|
|
9 INTEGER, POINTER :: I=>NULL()
|
|
|
10 END TYPE T1
|
|
|
11 type(T1), pointer :: tar(:)
|
|
|
12
|
|
|
13 character(20) res
|
|
|
14
|
|
|
15 j = 10
|
|
|
16 PRINT *, LEN(SUB(8)), ans
|
|
|
17 PRINT *, LEN(SUB(j)), ans
|
|
|
18 ! print *, len(SUB(j + 2)//"a"), ans ! This still fails (no charlen).
|
|
|
19 print *, len(bar(2)), ans
|
|
|
20
|
|
131
|
21 IF(.NOT.ASSOCIATED(F1(10))) STOP 1
|
|
111
|
22 deallocate (tar)
|
|
|
23
|
|
|
24 CONTAINS
|
|
|
25
|
|
|
26 FUNCTION SUB(I)
|
|
|
27 CHARACTER(LEN=I) :: SUB(1)
|
|
|
28 ans = LEN(SUB(1))
|
|
|
29 SUB = ""
|
|
|
30 END FUNCTION
|
|
|
31
|
|
|
32 FUNCTION BAR(I)
|
|
|
33 CHARACTER(LEN=I*10) :: BAR(1)
|
|
|
34 ans = LEN(BAR)
|
|
|
35 BAR = ""
|
|
|
36 END FUNCTION
|
|
|
37
|
|
|
38 FUNCTION F1(I) RESULT(R)
|
|
|
39 TYPE(T1), DIMENSION(:), POINTER :: R
|
|
|
40 INTEGER :: I
|
|
|
41 ALLOCATE(tar(I))
|
|
|
42 R => tar
|
|
|
43 END FUNCTION F1
|
|
|
44 END
|
