From 3d727c42161d7e2ed8a3e74985fc8e9081909c54 Mon Sep 17 00:00:00 2001 From: Jeffrey A Law Date: Sun, 28 Jun 1998 13:57:18 +0000 Subject: [PATCH] 980628-4.f: New test from Craig. * g77.f-torture/execute/980628-4.f: New test from Craig. * g77.f-torture/execute/980628-5.f: Likewise. * g77.f-torture/execute/980628-2.f: Likewise. * g77.f-torture/execute/980628-0.f: Likewise. * g77.f-torture/execute/980628-1.f: Likewise. * g77.f-torture/execute/980628-3.f: Likewise. From-SVN: r20782 --- gcc/testsuite/ChangeLog | 3 + gcc/testsuite/g77.f-torture/execute/980628-0.f | 61 +++++++++++++++++++ gcc/testsuite/g77.f-torture/execute/980628-1.f | 62 ++++++++++++++++++++ gcc/testsuite/g77.f-torture/execute/980628-3.f | 81 ++++++++++++++++++++++++++ 4 files changed, 207 insertions(+) create mode 100644 gcc/testsuite/g77.f-torture/execute/980628-0.f create mode 100644 gcc/testsuite/g77.f-torture/execute/980628-1.f create mode 100644 gcc/testsuite/g77.f-torture/execute/980628-3.f diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 82b34e1..3d7c2af 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -3,6 +3,9 @@ Sun Jun 28 12:49:02 1998 Jeffrey A Law (law@cygnus.com) * g77.f-torture/execute/980628-4.f: New test from Craig. * g77.f-torture/execute/980628-5.f: Likewise. * g77.f-torture/execute/980628-2.f: Likewise. + * g77.f-torture/execute/980628-0.f: Likewise. + * g77.f-torture/execute/980628-1.f: Likewise. + * g77.f-torture/execute/980628-3.f: Likewise. Sun Jun 28 00:37:26 1998 Jeffrey A Law (law@cygnus.com) diff --git a/gcc/testsuite/g77.f-torture/execute/980628-0.f b/gcc/testsuite/g77.f-torture/execute/980628-0.f new file mode 100644 index 0000000..c36b1ef --- /dev/null +++ b/gcc/testsuite/g77.f-torture/execute/980628-0.f @@ -0,0 +1,61 @@ +* 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 (r1(2), d1) + equivalence (r2(2), d2) + equivalence (r3(2), d3) + + 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-1.f b/gcc/testsuite/g77.f-torture/execute/980628-1.f new file mode 100644 index 0000000..6ab0a0a --- /dev/null +++ b/gcc/testsuite/g77.f-torture/execute/980628-1.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 + save + + real r1(5), r2(5), r3(5) + double precision d1, d2, d3 + integer i1, i2, i3 + equivalence (r1(2), d1) + equivalence (r2(2), d2) + equivalence (r3(2), d3) + + 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-3.f b/gcc/testsuite/g77.f-torture/execute/980628-3.f new file mode 100644 index 0000000..3cf66e5 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/execute/980628-3.f @@ -0,0 +1,81 @@ +Return-Path: owner-egcs-patches@cygnus.com Sun +Received: from cygnus.com (runyon.cygnus.com [205.180.230.5]) by hurl.cygnus.com with ESMTP (8.7.1/8.7.1) id NAA10299 for ; Sun, 28 Jun 1998 13:57:57 -0600 (MDT) +Received: (from majordom@localhost) + by runyon.cygnus.com (8.8.7-cygnus/8.8.7) id KAA00196; + Sun, 28 Jun 1998 10:30:03 -0700 (PDT) +Received: from mescaline.gnu.org (mescaline.gnu.org [158.121.106.21]) + by runyon.cygnus.com (8.8.7-cygnus/8.8.7) with ESMTP id KAA00177 + for ; Sun, 28 Jun 1998 10:30:00 -0700 (PDT) +Received: from melange.gnu.org by mescaline.gnu.org (8.8.5/8.6.12GNU) with ESMTP id NAA19196 for ; Sun, 28 Jun 1998 13:30:18 -0400 +Received: (burley@localhost) by melange.gnu.org (8.8.5/8.6.12GNU) id NAA11244; Sun, 28 Jun 1998 13:29:59 -0400 (EDT) +Date: Sun, 28 Jun 1998 13:29:59 -0400 (EDT) +Message-Id: <199806281729.NAA11244@melange.gnu.org> +From: Craig Burley +To: egcs-patches@cygnus.com +Subject: New test (4th of 4) for g77 test suite +Sender: owner-egcs-patches@cygnus.com +Precedence: bulk + +Jeff, could you add this as: + + egcs/gcc/testsuite/g77.f-torture/execute/980628-3.f + + tq vm, (burley) + + +* 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 (c1(2), r1) + equivalence (c2(2), r2) + equivalence (c3(2), r3) + + 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 -- 2.7.4