URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [alloc_comp_assign_3.f90] - Blame information for rev 823

Line No.	Rev	Author	Line
1	149	jeremybenn	`! { dg-do run }`
2			`! Test assignments of nested derived types with allocatable components(PR 20541).`
3			`!`
4			`! Contributed by Erik Edelmann`
5			`! and Paul Thomas`
6			`!`
7			`type :: a`
8			`integer, allocatable :: i(:)`
9			`end type a`
10
11			`type :: b`
12			`type (a), allocatable :: at(:)`
13			`end type b`
14
15			`type(a) :: x(2)`
16			`type(b) :: y(2), z(2)`
17			`integer i, m(4)`
18
19			`x(1) = a((/1,2,3,4/))`
20			`x(2) = a((/1,2,3,4/)+10)`
21
22			`y(1) = b((/x(1),x(2)/))`
23			`y(2) = b((/x(2),x(1)/))`
24
25			`y(2) = y(1)`
26			`forall (j=1:2,k=1:4, y(1)%at(j)%i(k) .ne. y(2)%at(j)%i(k)) &`
27			`y(1)%at(j)%i(k) = 999`
28			`if (any ((/((y(1)%at(j)%i(k), k=1,4),j=1,2)/) .eq. 999)) call abort ()`
29
30
31			`z = y`
32			`forall (i=1:2,j=1:2,k=1:4, z(i)%at(j)%i(k) .ne. y(i)%at(j)%i(k)) &`
33			`z(i)%at(j)%i(k) = 999`
34			`if (any ((/(((z(i)%at(j)%i(k), k=1,4),j=1,2),i=1,2)/) .eq. 999)) call abort ()`
35
36			`end`