mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2024-12-19 18:40:06 +08:00
Code Issues Packages Projects Releases Wiki Activity

New test from Craig.

Browse Source 
From-SVN: r20873
This commit is contained in:
Dave Love 1998-07-01 10:57:06 +00:00
parent a752ed6510
commit 28e59669c0
2 changed files with 144 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
gcc/testsuite/g77.f-torture/execute/980701-0.f Normal file
View File

@ -0,0 +1,72 @@
* g77 0.5.23 and previous had bugs involving too little space
* allocated for EQUIVALENCE and COMMON areas needing initial
* padding to meet alignment requirements of the system.
call subr
end
subroutine subr
implicit none
real r1(5), r2(5), r3(5)
real s1(2), s2(2), s3(2)
double precision d1, d2, d3
integer i1, i2, i3
equivalence (r1, s1(2))
equivalence (d1, r1(2))
equivalence (r2, s2(2))
equivalence (d2, r2(2))
equivalence (r3, s3(2))
equivalence (d3, r3(2))
s1(1) = 1.
r1(1) = 1.
d1 = 10.
r1(4) = 1.
r1(5) = 1.
i1 = 1
s2(1) = 2.
r2(1) = 2.
d2 = 20.
r2(4) = 2.
r2(5) = 2.
i2 = 2
s3(1) = 3.
r3(1) = 3.
d3 = 30.
r3(4) = 3.
r3(5) = 3.
i3 = 3
call x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
end
subroutine x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
implicit none
real r1(5), r2(5), r3(5)
real s1(2), s2(2), s3(2)
double precision d1, d2, d3
integer i1, i2, i3
if (s1(1) .ne. 1.) call abort
if (r1(1) .ne. 1.) call abort
if (d1 .ne. 10.) call abort
if (r1(4) .ne. 1.) call abort
if (r1(5) .ne. 1.) call abort
if (i1 .ne. 1) call abort
if (s2(1) .ne. 2.) call abort
if (r2(1) .ne. 2.) call abort
if (d2 .ne. 20.) call abort
if (r2(4) .ne. 2.) call abort
if (r2(5) .ne. 2.) call abort
if (i2 .ne. 2) call abort
if (s3(1) .ne. 3.) call abort
if (r3(1) .ne. 3.) call abort
if (d3 .ne. 30.) call abort
if (r3(4) .ne. 3.) call abort
if (r3(5) .ne. 3.) call abort
if (i3 .ne. 3) call abort
end

72
gcc/testsuite/g77.f-torture/execute/980701-1.f Normal file
View File

@ -0,0 +1,72 @@
* g77 0.5.23 and previous had bugs involving too little space
* allocated for EQUIVALENCE and COMMON areas needing initial
* padding to meet alignment requirements of the system.
call subr
end
subroutine subr
implicit none
real r1(5), r2(5), r3(5)
real s1(2), s2(2), s3(2)
double precision d1, d2, d3
integer i1, i2, i3
equivalence (d1, r1(2))
equivalence (r1, s1(2))
equivalence (d2, r2(2))
equivalence (r2, s2(2))
equivalence (d3, r3(2))
equivalence (r3, s3(2))
s1(1) = 1.
r1(1) = 1.
d1 = 10.
r1(4) = 1.
r1(5) = 1.
i1 = 1
s2(1) = 2.
r2(1) = 2.
d2 = 20.
r2(4) = 2.
r2(5) = 2.
i2 = 2
s3(1) = 3.
r3(1) = 3.
d3 = 30.
r3(4) = 3.
r3(5) = 3.
i3 = 3
call x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
end
subroutine x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
implicit none
real r1(5), r2(5), r3(5)
real s1(2), s2(2), s3(2)
double precision d1, d2, d3
integer i1, i2, i3
if (s1(1) .ne. 1.) call abort
if (r1(1) .ne. 1.) call abort
if (d1 .ne. 10.) call abort
if (r1(4) .ne. 1.) call abort
if (r1(5) .ne. 1.) call abort
if (i1 .ne. 1) call abort
if (s2(1) .ne. 2.) call abort
if (r2(1) .ne. 2.) call abort
if (d2 .ne. 20.) call abort
if (r2(4) .ne. 2.) call abort
if (r2(5) .ne. 2.) call abort
if (i2 .ne. 2) call abort
if (s3(1) .ne. 3.) call abort
if (r3(1) .ne. 3.) call abort
if (d3 .ne. 30.) call abort
if (r3(4) .ne. 3.) call abort
if (r3(5) .ne. 3.) call abort
if (i3 .ne. 3) call abort
end