OSDN Git Service

2004-07-17 Jeroen Frijters <jeroen@frijters.net>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / g77.f-torture / execute / 980628-3.f
1 * g77 0.5.23 and previous had bugs involving too little space
2 * allocated for EQUIVALENCE and COMMON areas needing initial
3 * padding to meet alignment requirements of the system.
4
5       call subr
6       end
7
8       subroutine subr
9       implicit none
10       save
11
12       character c1(11), c2(11), c3(11)
13       real r1, r2, r3
14       character c4, c5, c6
15       equivalence (c1(2), r1)
16       equivalence (c2(2), r2)
17       equivalence (c3(2), r3)
18
19       c1(1) = '1'
20       r1 = 1.
21       c1(11) = '1'
22       c4 = '4'
23       c2(1) = '2'
24       r2 = 2.
25       c2(11) = '2'
26       c5 = '5'
27       c3(1) = '3'
28       r3 = 3.
29       c3(11) = '3'
30       c6 = '6'
31
32       call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
33
34       end
35
36       subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
37       implicit none
38
39       character c1(11), c2(11), c3(11)
40       real r1, r2, r3
41       character c4, c5, c6
42
43       if (c1(1) .ne. '1') call abort
44       if (r1 .ne. 1.) call abort
45       if (c1(11) .ne. '1') call abort
46       if (c4 .ne. '4') call abort
47       if (c2(1) .ne. '2') call abort
48       if (r2 .ne. 2.) call abort
49       if (c2(11) .ne. '2') call abort
50       if (c5 .ne. '5') call abort
51       if (c3(1) .ne. '3') call abort
52       if (r3 .ne. 3.) call abort
53       if (c3(11) .ne. '3') call abort
54       if (c6 .ne. '6') call abort
55
56       end