From 57701d2dbe866a3da435ca1c69c6bb7e57a7dada Mon Sep 17 00:00:00 2001 From: Dave Love Date: Tue, 30 Jun 1998 06:12:50 +0000 Subject: New test. git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@20815 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/g77.f-torture/execute/980628-10.f | 57 ++++++++++++++++++++++ gcc/testsuite/g77.f-torture/execute/980628-7.f | 62 ++++++++++++++++++++++++ gcc/testsuite/g77.f-torture/execute/980628-8.f | 63 +++++++++++++++++++++++++ gcc/testsuite/g77.f-torture/execute/980628-9.f | 56 ++++++++++++++++++++++ 4 files changed, 238 insertions(+) create mode 100644 gcc/testsuite/g77.f-torture/execute/980628-10.f create mode 100644 gcc/testsuite/g77.f-torture/execute/980628-7.f create mode 100644 gcc/testsuite/g77.f-torture/execute/980628-8.f create mode 100644 gcc/testsuite/g77.f-torture/execute/980628-9.f diff --git a/gcc/testsuite/g77.f-torture/execute/980628-10.f b/gcc/testsuite/g77.f-torture/execute/980628-10.f new file mode 100644 index 00000000000..427f635add9 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/execute/980628-10.f @@ -0,0 +1,57 @@ +* 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 + save + + character c1(11), c2(11), c3(11) + real r1, r2, r3 + character c4, c5, c6 + equivalence (r1, c1(2)) + equivalence (r2, c2(2)) + equivalence (r3, c3(2)) + + c1(1) = '1' + r1 = 1. + c1(11) = '1' + c4 = '4' + c2(1) = '2' + r2 = 2. + c2(11) = '2' + c5 = '5' + c3(1) = '3' + r3 = 3. + c3(11) = '3' + c6 = '6' + + call x (c1, r1, c2, r2, c3, r3, c4, c5, c6) + + end + + subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6) + implicit none + + character c1(11), c2(11), c3(11) + real r1, r2, r3 + character c4, c5, c6 + + if (c1(1) .ne. '1') call abort + if (r1 .ne. 1.) call abort + if (c1(11) .ne. '1') call abort + if (c4 .ne. '4') call abort + if (c2(1) .ne. '2') call abort + if (r2 .ne. 2.) call abort + if (c2(11) .ne. '2') call abort + if (c5 .ne. '5') call abort + if (c3(1) .ne. '3') call abort + if (r3 .ne. 3.) call abort + if (c3(11) .ne. '3') call abort + if (c6 .ne. '6') call abort + + end + diff --git a/gcc/testsuite/g77.f-torture/execute/980628-7.f b/gcc/testsuite/g77.f-torture/execute/980628-7.f new file mode 100644 index 00000000000..c81ba31fc26 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/execute/980628-7.f @@ -0,0 +1,62 @@ +* 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) + double precision d1, d2, d3 + integer i1, i2, i3 + equivalence (d1, r1(2)) + equivalence (d2, r2(2)) + equivalence (d3, r3(2)) + + r1(1) = 1. + d1 = 10. + r1(4) = 1. + r1(5) = 1. + i1 = 1 + r2(1) = 2. + d2 = 20. + r2(4) = 2. + r2(5) = 2. + i2 = 2 + r3(1) = 3. + d3 = 30. + r3(4) = 3. + r3(5) = 3. + i3 = 3 + + call x (r1, d1, i1, r2, d2, i2, r3, d3, i3) + + end + + subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3) + implicit none + + real r1(5), r2(5), r3(5) + double precision d1, d2, d3 + integer i1, i2, i3 + + 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 (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 (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 + diff --git a/gcc/testsuite/g77.f-torture/execute/980628-8.f b/gcc/testsuite/g77.f-torture/execute/980628-8.f new file mode 100644 index 00000000000..8940d009954 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/execute/980628-8.f @@ -0,0 +1,63 @@ +* 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 + save + + real r1(5), r2(5), r3(5) + double precision d1, d2, d3 + integer i1, i2, i3 + equivalence (d1, r1(2)) + equivalence (d2, r2(2)) + equivalence (d3, r3(2)) + + r1(1) = 1. + d1 = 10. + r1(4) = 1. + r1(5) = 1. + i1 = 1 + r2(1) = 2. + d2 = 20. + r2(4) = 2. + r2(5) = 2. + i2 = 2 + r3(1) = 3. + d3 = 30. + r3(4) = 3. + r3(5) = 3. + i3 = 3 + + call x (r1, d1, i1, r2, d2, i2, r3, d3, i3) + + end + + subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3) + implicit none + + real r1(5), r2(5), r3(5) + double precision d1, d2, d3 + integer i1, i2, i3 + + 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 (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 (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 + diff --git a/gcc/testsuite/g77.f-torture/execute/980628-9.f b/gcc/testsuite/g77.f-torture/execute/980628-9.f new file mode 100644 index 00000000000..54e6552d628 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/execute/980628-9.f @@ -0,0 +1,56 @@ +* 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 + + character c1(11), c2(11), c3(11) + real r1, r2, r3 + character c4, c5, c6 + equivalence (r1, c1(2)) + equivalence (r2, c2(2)) + equivalence (r3, c3(2)) + + c1(1) = '1' + r1 = 1. + c1(11) = '1' + c4 = '4' + c2(1) = '2' + r2 = 2. + c2(11) = '2' + c5 = '5' + c3(1) = '3' + r3 = 3. + c3(11) = '3' + c6 = '6' + + call x (c1, r1, c2, r2, c3, r3, c4, c5, c6) + + end + + subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6) + implicit none + + character c1(11), c2(11), c3(11) + real r1, r2, r3 + character c4, c5, c6 + + if (c1(1) .ne. '1') call abort + if (r1 .ne. 1.) call abort + if (c1(11) .ne. '1') call abort + if (c4 .ne. '4') call abort + if (c2(1) .ne. '2') call abort + if (r2 .ne. 2.) call abort + if (c2(11) .ne. '2') call abort + if (c5 .ne. '5') call abort + if (c3(1) .ne. '3') call abort + if (r3 .ne. 3.) call abort + if (c3(11) .ne. '3') call abort + if (c6 .ne. '6') call abort + + end + -- cgit v1.2.3