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 (file)
index 0000000..1c89d5a
--- /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 <nathan@codesourcery.com>
+
+// Origin:   Ivan Godard <igodard@pacbell.net>
+// Bug 20789: ICE on invalid
+
+template<typename> struct A;
+
+template<int> struct B {};
+
+template<typename T> struct C
+{
+  static const int i = A<T>::i;  // { dg-error "incomplete" }
+  static const int j = i;      // { dg-error "initialized by a non-const" }
+  B<j> b;  // { dg-error "not a valid template arg" }
+};
+
+C<int> 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 (file)
index 0000000..35f23e8
--- /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 <nathan@codesourcery.com>
+
+// 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 (file)
index 0000000..2b4f165
--- /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 <nathan@codesourcery.com>
+
+// Origin:  Volker Reichelt <reichelt@gcc.gnu.org>
+// Bug 21929: ICE on invalid
+
+template<int> struct A
+{
+    struct B;
+};
+
+template<> struct A<void>::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 (file)
index 0000000..34ad75d
--- /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 (file)
index 0000000..f7b28d4
--- /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 (file)
index 0000000..0849358
--- /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 (file)
index 0000000..b691f21
--- /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 (file)
index 0000000..c15ff7a
--- /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 (file)
index 0000000..76c3938
--- /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 (file)
index 0000000..b9ea268
--- /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 (file)
index 0000000..ed3b8ec
--- /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 <paul@nowt.org>
+
+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 <stdlib.h>
+#include <assert.h>
+#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 (file)
index 0000000..e313540
--- /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 <paul@nowt.org>
+
+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 <stdlib.h>
+#include <assert.h>
+#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 (file)
index 0000000..e24939e
--- /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 <paul@nowt.org>
+
+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 <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#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 (file)
index 0000000..6686507
--- /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 <paul@nowt.org>
+
+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 <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#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];
+            }
+        }
+    }
+}
+