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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [assumed_size.f90] - Blame information for rev 774

Line No.	Rev	Author	Line
1	695	jeremybenn	`! Program to test assumed size arrays`
2			`subroutine test2(p)`
3			`integer, dimension(2, *) :: p`
4
5			`if (any (p(:, 1:3) .ne. reshape((/1, 2, 4, 5, 7, 8/), (/2, 3/)))) &`
6			`call abort ()`
7			`end subroutine`
8
9			`program assumed_size`
10			`integer, dimension (3, 3) :: a`
11			`external test2`
12
13			`a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))`
14
15			`call test1(a, (/1, 2, 3, 4, 5, 6/))`
16			`if (a(1,1) .ne. 0) call abort`
17			`a(1, 1) = 1`
18			`call test1(a(1:2, :), (/1, 2, 4, 5, 7, 8/))`
19			`if (a(1,1) .ne. 0) call abort`
20			`a(1, 1) = 1`
21			`call test1(a(3:1:-1, :), (/3, 2, 1, 6, 5, 4/))`
22			`if (a(3,1) .ne. 0) call abort`
23			`a(3, 1) = 3`
24			`call test1(a(:, 2:3), (/4, 5, 6, 7, 8, 9/))`
25			`if (a(1, 2) .ne. 0) call abort`
26			`a(1, 2) = 4`
27
28			`call test2(a(1:2, :))`
29			`call test2((/1, 2, 4, 5, 7, 8/))`
30			`contains`
31			`subroutine test1(p, q)`
32			`integer, dimension(*) :: p`
33			`integer, dimension(1:) :: q`
34
35			`if (any (p(1:size(q)) .ne. q)) call abort ()`
36			`p(1) = 0`
37			`end subroutine`
38
39			`end program`