1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
! { dg-do run }
!
! Test the fix for PR46991 - enable class assumed size arrays
!
! Reported by Tobias Burnus <burnus@gcc.gnu.org>
! from http://j3-fortran.org/pipermail/j3/2010-December/004084.html
! submitted by Robert Corbett.
!
MODULE TYPES
PRIVATE
PUBLIC REC, REC2
TYPE REC
INTEGER A
END TYPE
TYPE, EXTENDS(REC) :: REC2
INTEGER B
END TYPE
END
SUBROUTINE SUB1(A, N)
USE TYPES
CLASS(REC), INTENT(IN) :: A(*)
INTERFACE
SUBROUTINE SUB2(A, N, IARRAY)
USE TYPES
TYPE(REC) A(*)
INTEGER :: N, IARRAY(N)
END
END INTERFACE
CALL SUB2(A, N,[1,2,2,3,3,4,4,5,5,6])
select type (B => A(1:N))
type is (REC2)
call SUB2(B%REC,N,[1,2,3,4,5,6,7,8,9,10])
end select
END
SUBROUTINE SUB2(A, N, IARRAY)
USE TYPES
TYPE(REC) A(*)
INTEGER :: N, IARRAY(N)
if (any (A(:N)%A .ne. IARRAY(:N))) stop 1
END
PROGRAM MAIN
USE TYPES
CLASS(REC), ALLOCATABLE :: A(:)
INTERFACE
SUBROUTINE SUB1(A, N)
USE TYPES
CLASS(REC), INTENT(IN) :: A(*)
END SUBROUTINE
END INTERFACE
A = [ (REC2(I, I+1), I = 1, 10) ]
CALL SUB1(A, 10)
END
|
