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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
! { dg-do run }
! Further test of typebound defined assignment
!
module m0
implicit none
type component
integer :: i = 0
contains
procedure :: assign0
generic :: assignment(=)=>assign0
end type
type parent
type(component) :: foo(2)
end type
type, extends(parent) :: child
integer :: j
end type
contains
elemental subroutine assign0(lhs,rhs)
class(component), intent(INout) :: lhs
class(component), intent(in) :: rhs
lhs%i = 20
end subroutine
end module
module m1
implicit none
type component1
integer :: i = 0
contains
procedure :: assign1
generic :: assignment(=)=>assign1
end type
type parent1
type(component1) :: foo
end type
type, extends(parent1) :: child1
integer :: j = 7
end type
contains
elemental subroutine assign1(lhs,rhs)
class(component1), intent(out) :: lhs
class(component1), intent(in) :: rhs
lhs%i = 30
end subroutine
end module
program main
use m0
use m1
implicit none
type(child) :: infant(2)
type(parent) :: dad, mum
type(child1) :: orphan(5)
type(child1), allocatable :: annie(:)
integer :: i, j, k
dad = parent ([component (3), component (4)])
mum = parent ([component (5), component (6)])
infant = [child(dad, 999), child(mum, 9999)] ! { dg-warning "multiple part array references" }
! Check that array sections are OK
i = 3
j = 4
orphan(i:j) = child1(component1(777), 1)
if (any (orphan%parent1%foo%i .ne. [0,0,30,30,0])) call abort
if (any (orphan%j .ne. [7,7,1,1,7])) call abort
! Check that allocatable lhs's work OK.
annie = [(child1(component1(k), 2*k), k = 1,3)]
if (any (annie%parent1%foo%i .ne. [30,30,30])) call abort
if (any (annie%j .ne. [2,4,6])) call abort
end
|
