2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / testsuite / g77.f-torture / execute / 980628-2.f
bloba140e7db61156da414344967509220a01ced5d30
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.
5 call subr
6 end
8 subroutine subr
9 implicit none
11 character c1(11), c2(11), c3(11)
12 real r1, r2, r3
13 character c4, c5, c6
14 equivalence (c1(2), r1)
15 equivalence (c2(2), r2)
16 equivalence (c3(2), r3)
18 c1(1) = '1'
19 r1 = 1.
20 c1(11) = '1'
21 c4 = '4'
22 c2(1) = '2'
23 r2 = 2.
24 c2(11) = '2'
25 c5 = '5'
26 c3(1) = '3'
27 r3 = 3.
28 c3(11) = '3'
29 c6 = '6'
31 call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
33 end
35 subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
36 implicit none
38 character c1(11), c2(11), c3(11)
39 real r1, r2, r3
40 character c4, c5, c6
42 if (c1(1) .ne. '1') call abort
43 if (r1 .ne. 1.) call abort
44 if (c1(11) .ne. '1') call abort
45 if (c4 .ne. '4') call abort
46 if (c2(1) .ne. '2') call abort
47 if (r2 .ne. 2.) call abort
48 if (c2(11) .ne. '2') call abort
49 if (c5 .ne. '5') call abort
50 if (c3(1) .ne. '3') call abort
51 if (r3 .ne. 3.) call abort
52 if (c3(11) .ne. '3') call abort
53 if (c6 .ne. '6') call abort
55 end