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

Subversion Repositories openrisc

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

Line No.	Rev	Author	Line
1	695	jeremybenn	`! Program to test COMMON and EQUIVALENCE.`
2			`program common`
3			`real (kind=8) a(8)`
4			`real (kind=8) b(5), c(5)`
5			`common /com1/b,c`
6			`equivalence (a(1), b(2))`
7			`b = 100`
8			`c = 200`
9			`call common_pass`
10			`call common_par (a, b,c)`
11			`call global_equiv`
12			`call local_equiv`
13			`end`
14
15			`! Use common block to pass values`
16			`subroutine common_pass`
17			`real (kind=8) a(8)`
18			`real (kind=8) b(5), c(5)`
19			`common /com1/b,c`
20			`equivalence (a(1), b(2))`
21			`if (any (a .ne. (/100,100,100,100,200,200,200,200/))) call abort`
22			`end subroutine`
23
24			`! Common variables as argument`
25			`subroutine common_par (a, b, c)`
26			`real (kind=8) a(8), b(5), c(5)`
27			`if (any (a .ne. (/100,100,100,100,200,200,200,200/))) call abort`
28			`if (any (b .ne. (/100,100,100,100,100/))) call abort`
29			`if (any (c .ne. (/200,200,200,200,200/))) call abort`
30			`end subroutine`
31
32			`! Global equivalence`
33			`subroutine global_equiv`
34			`real (kind=8) a(8), b(5), c(5), x(8), y(4), z(4)`
35			`common /com2/b, c, y, z`
36			`equivalence (a(1), b(2))`
37			`equivalence (x(4), y(1))`
38			`b = 100`
39			`c = 200`
40			`y = 300`
41			`z = 400`
42			`if (any (a .ne. (/100,100,100,100,200,200,200,200/))) call abort`
43			`if (any (x .ne. (/200,200,200,300,300,300,300,400/))) call abort`
44			`end`
45
46			`! Local equivalence`
47			`subroutine local_equiv`
48			`real (kind=8) a(8), b(10)`
49			`equivalence (a(1), b(3))`
50			`b(1:5) = 100`
51			`b(6:10) = 200`
52			`if (any (a .ne. (/100,100,100,200,200,200,200,200/))) call abort`
53			`end subroutine`