131
|
1 ! { dg-do run }
|
|
2 !
|
|
3 ! Test the fix for PR70752 in which the type of the component 'c' is cast
|
|
4 ! as character[1:0], which makes it slightly more difficult than usual to
|
|
5 ! obtain the element length. This is one and the same bug as PR72709.
|
|
6 !
|
|
7 ! Contributed by Gilbert Scott <gilbert.scott@easynet.co.uk>
|
|
8 !
|
|
9 PROGRAM TEST
|
|
10 IMPLICIT NONE
|
|
11 INTEGER, PARAMETER :: I = 3
|
|
12 character (len = i), parameter :: str(5) = ['abc','cde','fgh','ijk','lmn']
|
|
13
|
|
14 TYPE T
|
|
15 CHARACTER(LEN=:), ALLOCATABLE :: C(:)
|
|
16 END TYPE T
|
|
17 TYPE(T), TARGET :: S
|
|
18 CHARACTER (LEN=I), POINTER :: P(:)
|
|
19
|
|
20 ALLOCATE ( CHARACTER(LEN=I) :: S%C(5) )
|
|
21 s%c = str
|
|
22
|
|
23 ! This PR uncovered several problems associated with determining the
|
|
24 ! element length and indexing. Test fairly thoroughly!
|
|
25 if (SIZE(S%C, 1) .ne. 5) stop 1
|
|
26 if (LEN(S%C) .ne. 3) stop 2
|
|
27 if (any (s%c .ne. str)) stop 3
|
|
28 if (s%c(3) .ne. str(3)) stop 4
|
|
29 P => S%C
|
|
30 if (SIZE(p, 1) .ne. 5) stop 5
|
|
31 if (LEN(p) .ne. 3) stop 6
|
|
32 if (any (p .ne. str)) stop 7
|
|
33 if (p(5) .ne. str(5)) stop 8
|
|
34 END PROGRAM TEST
|