From: No Author Date: Thu, 16 Jun 2005 23:00:39 +0000 (+0000) Subject: This commit was manufactured by cvs2svn to create branch X-Git-Tag: releases/gcc-4.0.1~53 X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=a41042d5911f39c3070f1f659152c8dfdfcc123b;p=thirdparty%2Fgcc.git This commit was manufactured by cvs2svn to create branch 'gcc-4_0-branch'. From-SVN: r101106 --- diff --git a/gcc/testsuite/g++.dg/init/member1.C b/gcc/testsuite/g++.dg/init/member1.C new file mode 100644 index 000000000000..1c89d5a1d43d --- /dev/null +++ b/gcc/testsuite/g++.dg/init/member1.C @@ -0,0 +1,18 @@ +// Copyright (C) 2005 Free Software Foundation, Inc. +// Contributed by Nathan Sidwell 13 Jun 2005 + +// Origin: Ivan Godard +// Bug 20789: ICE on invalid + +template struct A; + +template struct B {}; + +template struct C +{ + static const int i = A::i; // { dg-error "incomplete" } + static const int j = i; // { dg-error "initialized by a non-const" } + B b; // { dg-error "not a valid template arg" } +}; + +C c; diff --git a/gcc/testsuite/g++.dg/other/crash-4.C b/gcc/testsuite/g++.dg/other/crash-4.C new file mode 100644 index 000000000000..35f23e8ccc00 --- /dev/null +++ b/gcc/testsuite/g++.dg/other/crash-4.C @@ -0,0 +1,19 @@ +// Copyright (C) 2005 Free Software Foundation, Inc. +// Contributed by Nathan Sidwell 14 Jun 2005 + +// PR 20678: ICE on error message +// Origin: Andrew Pinski pinskia@gcc.gnu.org + +struct a +{ + a(const a&); +}; +struct b +{ // { dg-error "cannot bind packed field" } + a aa __attribute__((packed)); +}; +struct c +{ + b bb; + c(const b& __a): bb(__a) {} // { dg-error "synthesized" } +}; diff --git a/gcc/testsuite/g++.dg/parse/crash26.C b/gcc/testsuite/g++.dg/parse/crash26.C new file mode 100644 index 000000000000..2b4f165f8b9a --- /dev/null +++ b/gcc/testsuite/g++.dg/parse/crash26.C @@ -0,0 +1,12 @@ +// Copyright (C) 2005 Free Software Foundation, Inc. +// Contributed by Nathan Sidwell 13 Jun 2005 + +// Origin: Volker Reichelt +// Bug 21929: ICE on invalid + +template struct A +{ + struct B; +}; + +template<> struct A::B {}; // { dg-error "mismatch|expected|name a type|extra" } diff --git a/gcc/testsuite/gcc.dg/simd-3.c b/gcc/testsuite/gcc.dg/simd-3.c new file mode 100644 index 000000000000..34ad75d96024 --- /dev/null +++ b/gcc/testsuite/gcc.dg/simd-3.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-maltivec" { target powerpc-*-* } } */ + +__attribute__ ((vector_size (2))) signed char v1, v2, v3; +void +one (void) +{ + v1 = v2 + v3; +} + +__attribute__ ((vector_size (8))) signed char v4, v5, v6; +void +two (void) +{ + v4 = v5 + v6; +} diff --git a/gcc/testsuite/gcc.dg/simd-4.c b/gcc/testsuite/gcc.dg/simd-4.c new file mode 100644 index 000000000000..f7b28d452298 --- /dev/null +++ b/gcc/testsuite/gcc.dg/simd-4.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ + +typedef int myint; + +float __attribute__((vector_size(16))) b; +int __attribute__((vector_size(16))) d; +myint __attribute__((vector_size(16))) d2; +unsigned int __attribute__((vector_size(16))) e; + +void foo() +{ + b + d; /* { dg-error "invalid operands to binary" } */ + d += e; + d2 += d; +} diff --git a/gcc/testsuite/gfortran.dg/altreturn_1.f90 b/gcc/testsuite/gfortran.dg/altreturn_1.f90 new file mode 100644 index 000000000000..0849358697ff --- /dev/null +++ b/gcc/testsuite/gfortran.dg/altreturn_1.f90 @@ -0,0 +1,7 @@ +! { dg-do compile } + subroutine foo (a) + real t, a, baz + call bar (*10) + t = 2 * baz () + IF (t.gt.0) t = baz () +10 END diff --git a/gcc/testsuite/gfortran.dg/deallocate_stat.f90 b/gcc/testsuite/gfortran.dg/deallocate_stat.f90 new file mode 100644 index 000000000000..b691f21c74ed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deallocate_stat.f90 @@ -0,0 +1,77 @@ +! { dg-do run } +! PR 17792 +! PR 21375 +! Test that the STAT argument to DEALLOCATE works with POINTERS and +! ALLOCATABLE arrays. +program deallocate_stat + + implicit none + + integer i + real, pointer :: a1(:), a2(:,:), a3(:,:,:), a4(:,:,:,:), & + & a5(:,:,:,:,:), a6(:,:,:,:,:,:), a7(:,:,:,:,:,:,:) + + real, allocatable :: b1(:), b2(:,:), b3(:,:,:), b4(:,:,:,:), & + & b5(:,:,:,:,:), b6(:,:,:,:,:,:), b7(:,:,:,:,:,:,:) + + allocate(a1(2), a2(2,2), a3(2,2,2), a4(2,2,2,2), a5(2,2,2,2,2)) + allocate(a6(2,2,2,2,2,2), a7(2,2,2,2,2,2,2)) + + a1 = 1. ; a2 = 2. ; a3 = 3. ; a4 = 4. ; a5 = 5. ; a6 = 6. ; a7 = 7. + + i = 13 + deallocate(a1, stat=i) ; if (i /= 0) call abort + deallocate(a2, stat=i) ; if (i /= 0) call abort + deallocate(a3, stat=i) ; if (i /= 0) call abort + deallocate(a4, stat=i) ; if (i /= 0) call abort + deallocate(a5, stat=i) ; if (i /= 0) call abort + deallocate(a6, stat=i) ; if (i /= 0) call abort + deallocate(a7, stat=i) ; if (i /= 0) call abort + + i = 14 + deallocate(a1, stat=i) ; if (i /= 1) call abort + deallocate(a2, stat=i) ; if (i /= 1) call abort + deallocate(a3, stat=i) ; if (i /= 1) call abort + deallocate(a4, stat=i) ; if (i /= 1) call abort + deallocate(a5, stat=i) ; if (i /= 1) call abort + deallocate(a6, stat=i) ; if (i /= 1) call abort + deallocate(a7, stat=i) ; if (i /= 1) call abort + + allocate(b1(2), b2(2,2), b3(2,2,2), b4(2,2,2,2), b5(2,2,2,2,2)) + allocate(b6(2,2,2,2,2,2), b7(2,2,2,2,2,2,2)) + + b1 = 1. ; b2 = 2. ; b3 = 3. ; b4 = 4. ; b5 = 5. ; b6 = 6. ; b7 = 7. + + i = 13 + deallocate(b1, stat=i) ; if (i /= 0) call abort + deallocate(b2, stat=i) ; if (i /= 0) call abort + deallocate(b3, stat=i) ; if (i /= 0) call abort + deallocate(b4, stat=i) ; if (i /= 0) call abort + deallocate(b5, stat=i) ; if (i /= 0) call abort + deallocate(b6, stat=i) ; if (i /= 0) call abort + deallocate(b7, stat=i) ; if (i /= 0) call abort + + i = 14 + deallocate(b1, stat=i) ; if (i /= 1) call abort + deallocate(b2, stat=i) ; if (i /= 1) call abort + deallocate(b3, stat=i) ; if (i /= 1) call abort + deallocate(b4, stat=i) ; if (i /= 1) call abort + deallocate(b5, stat=i) ; if (i /= 1) call abort + deallocate(b6, stat=i) ; if (i /= 1) call abort + deallocate(b7, stat=i) ; if (i /= 1) call abort + + + allocate(a1(2), a2(2,2), a3(2,2,2), b4(2,2,2,2), b5(2,2,2,2,2)) + allocate(b6(2,2,2,2,2,2)) + + a1 = 1. ; a2 = 2. ; a3 = 3. ; b4 = 4. ; b5 = 5. ; b6 = 6. + + i = 13 + deallocate(a1, stat=i) ; if (i /= 0) call abort + deallocate(a2, a1, stat=i) ; if (i /= 1) call abort + deallocate(a1, a3, a2, stat=i) ; if (i /= 2) call abort + deallocate(b4, stat=i) ; if (i /= 0) call abort + deallocate(b4, b5, stat=i) ; if (i /= 1) call abort + deallocate(b4, b5, b6, stat=i) ; if (i /= 2) call abort + +end program deallocate_stat diff --git a/gcc/testsuite/gfortran.dg/f2c_7.f90 b/gcc/testsuite/gfortran.dg/f2c_7.f90 new file mode 100644 index 000000000000..c15ff7a0f2c8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2c_7.f90 @@ -0,0 +1,57 @@ +! { dg-do run } +! { dg-options "-ff2c" } +! Verifies that array results work with -ff2c +! try all permutations of result clause in function yes/no +! and result clause in interface yes/no +! this is not possible in Fortran 77, but this exercises a previously +! buggy codepath +function c() result (r) + complex :: r(5) + r = 0. +end function c + +function d() + complex :: d(5) + d = 1. +end function d + +subroutine test_without_result +interface + function c + complex :: c(5) + end function c +end interface +interface + function d + complex :: d(5) + end function d +end interface +complex z(5) +z = c() +if (any(z /= 0.)) call abort () +z = d() +if (any(z /= 1.)) call abort () +end subroutine test_without_result + +subroutine test_with_result +interface + function c result(r) + complex :: r(5) + end function c +end interface +interface + function d result(r) + complex :: r(5) + end function d +end interface +complex z(5) +z = c() +if (any(z /= 0.)) call abort () +z = d() +if (any(z /= 1.)) call abort () +end subroutine test_with_result + +call test_without_result +call test_with_result +end + diff --git a/gcc/testsuite/gfortran.dg/pr19216.f b/gcc/testsuite/gfortran.dg/pr19216.f new file mode 100644 index 000000000000..76c393836c97 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr19216.f @@ -0,0 +1,18 @@ +! PR libfortran/19216 +! { dg-do run } + integer dat(3), i, j + data dat / 3,2,1 / + + open (20, status='scratch') + write (20,'(A)') '/ 10 20 30' + write (20,'(A)') '1 2 3 4' + write (20,'(A)') '5 6 7 8' + rewind (20) + read (20,*) (dat(i), i=1,3) + if (dat(1).ne.3 .or. dat(2).ne.2 .or. dat(3).ne.1) call abort + read (20,*) I,J + if (i .ne. 1 .or. j .ne. 2) call abort + read (20,*) I,J + if (i .ne. 5 .or. j .ne. 6) call abort + close(20) + end diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f90 new file mode 100644 index 000000000000..b9ea26832402 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f90 @@ -0,0 +1,92 @@ +! Check in_pack and in_unpack for integer and comlex types, with +! alignment issues thrown in for good measure. + +program main + implicit none + + complex(kind=4) :: a4(5),b4(5),aa4(5),bb4(5) + real(kind=4) :: r4(100) + equivalence(a4(1),r4(1)),(b4(1),r4(12)) + + complex(kind=8) :: a8(5),b8(5),aa8(5),bb8(5) + real(kind=8) :: r8(100) + equivalence(a8(1),r8(1)),(b8(1),r8(12)) + + integer(kind=4) :: i4(5),ii4(5) + integer(kind=8) :: i8(5),ii8(5) + + integer :: i + + a4 = (/(cmplx(i,-i,kind=4),i=1,5)/) + b4 = (/(2*cmplx(i,-i,kind=4),i=1,5)/) + call csub4(a4(5:1:-1),b4(5:1:-1),5) + aa4 = (/(cmplx(5-i+1,i-5-1,kind=4),i=1,5)/) + if (any(aa4 /= a4)) call abort + bb4 = (/(2*cmplx(5-i+1,i-5-1,kind=4),i=1,5)/) + if (any(bb4 /= b4)) call abort + + a8 = (/(cmplx(i,-i,kind=8),i=1,5)/) + b8 = (/(2*cmplx(i,-i,kind=8),i=1,5)/) + call csub8(a8(5:1:-1),b8(5:1:-1),5) + aa8 = (/(cmplx(5-i+1,i-5-1,kind=8),i=1,5)/) + if (any(aa8 /= a8)) call abort + bb8 = (/(2*cmplx(5-i+1,i-5-1,kind=8),i=1,5)/) + if (any(bb8 /= b8)) call abort + + i4 = (/(i, i=1,5)/) + call isub4(i4(5:1:-1),5) + ii4 = (/(5-i+1,i=1,5)/) + if (any(ii4 /= i4)) call abort + + i8 = (/(i,i=1,5)/) + call isub8(i8(5:1:-1),5) + ii8 = (/(5-i+1,i=1,5)/) + if (any(ii8 /= i8)) call abort + +end program main + +subroutine csub4(a,b,n) + implicit none + complex(kind=4), dimension(n) :: a,b + complex(kind=4), dimension(n) :: aa, bb + integer :: n, i + aa = (/(cmplx(n-i+1,i-n-1,kind=4),i=1,n)/) + if (any(aa /= a)) call abort + bb = (/(2*cmplx(n-i+1,i-n-1,kind=4),i=1,5)/) + if (any(bb /= b)) call abort + a = (/(cmplx(i,-i,kind=4),i=1,5)/) + b = (/(2*cmplx(i,-i,kind=4),i=1,5)/) +end subroutine csub4 + +subroutine csub8(a,b,n) + implicit none + complex(kind=8), dimension(n) :: a,b + complex(kind=8), dimension(n) :: aa, bb + integer :: n, i + aa = (/(cmplx(n-i+1,i-n-1,kind=8),i=1,n)/) + if (any(aa /= a)) call abort + bb = (/(2*cmplx(n-i+1,i-n-1,kind=8),i=1,5)/) + if (any(bb /= b)) call abort + a = (/(cmplx(i,-i,kind=8),i=1,5)/) + b = (/(2*cmplx(i,-i,kind=8),i=1,5)/) +end subroutine csub8 + +subroutine isub4(a,n) + implicit none + integer(kind=4), dimension(n) :: a + integer(kind=4), dimension(n) :: aa + integer :: n, i + aa = (/(n-i+1,i=1,n)/) + if (any(aa /= a)) call abort + a = (/(i,i=1,5)/) +end subroutine isub4 + +subroutine isub8(a,n) + implicit none + integer(kind=8), dimension(n) :: a + integer(kind=8), dimension(n) :: aa + integer :: n, i + aa = (/(n-i+1,i=1,n)/) + if (any(aa /= a)) call abort + a = (/(i,i=1,5)/) +end subroutine isub8 diff --git a/libgfortran/generated/in_pack_c4.c b/libgfortran/generated/in_pack_c4.c new file mode 100644 index 000000000000..ed3b8ec6ef6b --- /dev/null +++ b/libgfortran/generated/in_pack_c4.c @@ -0,0 +1,123 @@ +/* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public License restrictions +do apply in other respects; for example, they cover modification of +the file, and distribution when not linked into a combine +executable.) + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public +License along with libgfortran; see the file COPYING. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include +#include +#include "libgfortran.h" + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_COMPLEX_4 * +internal_pack_c4 (gfc_array_c4 * source) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_COMPLEX_4 *src; + GFC_COMPLEX_4 *dest; + GFC_COMPLEX_4 *destptr; + int n; + int packed; + + if (source->dim[0].stride == 0) + { + source->dim[0].stride = 1; + return source->data; + } + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_COMPLEX_4 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_4)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; +} + diff --git a/libgfortran/generated/in_pack_c8.c b/libgfortran/generated/in_pack_c8.c new file mode 100644 index 000000000000..e313540f7bf4 --- /dev/null +++ b/libgfortran/generated/in_pack_c8.c @@ -0,0 +1,123 @@ +/* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public License restrictions +do apply in other respects; for example, they cover modification of +the file, and distribution when not linked into a combine +executable.) + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public +License along with libgfortran; see the file COPYING. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include +#include +#include "libgfortran.h" + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_COMPLEX_8 * +internal_pack_c8 (gfc_array_c8 * source) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_COMPLEX_8 *src; + GFC_COMPLEX_8 *dest; + GFC_COMPLEX_8 *destptr; + int n; + int packed; + + if (source->dim[0].stride == 0) + { + source->dim[0].stride = 1; + return source->data; + } + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_COMPLEX_8 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_8)); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; +} + diff --git a/libgfortran/generated/in_unpack_c4.c b/libgfortran/generated/in_unpack_c4.c new file mode 100644 index 000000000000..e24939e5e529 --- /dev/null +++ b/libgfortran/generated/in_unpack_c4.c @@ -0,0 +1,111 @@ +/* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public License restrictions +do apply in other respects; for example, they cover modification of +the file, and distribution when not linked into a combine +executable.) + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public +License along with libgfortran; see the file COPYING. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include +#include +#include +#include "libgfortran.h" + +void +internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * src) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_COMPLEX_4 *dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + if (d->dim[0].stride == 0) + d->dim[0].stride = 1; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + abort (); + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_4)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } +} + diff --git a/libgfortran/generated/in_unpack_c8.c b/libgfortran/generated/in_unpack_c8.c new file mode 100644 index 000000000000..66865075c021 --- /dev/null +++ b/libgfortran/generated/in_unpack_c8.c @@ -0,0 +1,111 @@ +/* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public License restrictions +do apply in other respects; for example, they cover modification of +the file, and distribution when not linked into a combine +executable.) + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public +License along with libgfortran; see the file COPYING. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include +#include +#include +#include "libgfortran.h" + +void +internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_COMPLEX_8 *dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + if (d->dim[0].stride == 0) + d->dim[0].stride = 1; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + abort (); + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_8)); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } +} +