[multiple changes]

2005-06-11  Thomas Koenig  <Thomas.Koenig@onlinde.de>

	PR libfortran/21333
	* Makefile.am: Add in_pack_c4.c, in_pack_c8.c, in_unpack_c4.c
	and in_unpack_c8.c.
	* Makefile.in: Regenerate.
	* libgfortran.h:  Declare internal_pack_c4, internal_pack_c8,
	internal_unpack_c4 and internal_unpack_c8.
	* m4/in_pack.m4: Use rtype_ccode insteald of rtype_kind
	in function name.
	Use sizeof (rtype_name) as size for memory allocation.
	* m4/in_unpack.m4: Use rtype_ccode insteald of rtype_kind
	in function name.
	Use sizeof (rtype_name) for calculation of sizes for memcpy.
	* runtime/in_pack_generic.c:  For real, integer and logical
	call internal_pack_4 if size==4 and internal_pack_8 if
	size==8.
	For complex, call internal_pack_c4 if size==8 and
	internal_pack_c8 if size==16.
	* runtime/in_unpack_generic.c: For real, integer and logical
        call internal_unpack_4 if size==4 and internal_unpack_8 if
        size==8.
        For complex, call internal_unpack_c4 if size==8 and
        internal_unpack_c8 if size==16.
	* generated/in_pack_i4.c:  Regenerated.
	* generated/in_pack_i8.c:  Regenerated.
	* generated/in_unpack_i4.c:  Regenerated.
	* generated/in_unpack_i8.c:  Regenerated.
	* generated/in_pack_c4.c:  New file.
	* generated/in_pack_c8.c:  New file.
	* generated/in_unpack_c4.c:  New file.
	* generated/in_unpack_c8.c:  New file.

2005-05-11  Thomas Koenig  <Thomas.Koenig@online.de>

	* gfortran.fortran-torture/execute/in-pack.f90:  New test.

From-SVN: r100842

gcc/testsuite/ChangeLog

+2005-05-11  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	* gfortran.fortran-torture/execute/in-pack.f90:  New test.
+
 2005-06-10  Dorit Nuzman  <dorit@il.ibm.com>
 
 	* gfortran.dg/vect/vect-4.f90: Update comments. Only one unaligned

gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f90

+!  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

libgfortran/Makefile.am

@@ -243,11 +243,15 @@ generated/cshift1_8.c
 
 in_pack_c = \
 generated/in_pack_i4.c \
-generated/in_pack_i8.c
+generated/in_pack_i8.c \
+generated/in_pack_c4.c \
+generated/in_pack_c8.c
 
 in_unpack_c = \
 generated/in_unpack_i4.c \
-generated/in_unpack_i8.c
+generated/in_unpack_i8.c \
+generated/in_unpack_c4.c \
+generated/in_unpack_c8.c
 
 i_exponent_c = \
 generated/exponent_r4.c \

libgfortran/Makefile.in

@@ -104,8 +104,10 @@ am__objects_21 = eoshift3_4.lo eoshift3_8.lo
 am__objects_22 = cshift1_4.lo cshift1_8.lo
 am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_c4.lo \
 	reshape_c8.lo
-am__objects_24 = in_pack_i4.lo in_pack_i8.lo
-am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo
+am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_c4.lo \
+	in_pack_c8.lo
+am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_c4.lo \
+	in_unpack_c8.lo
 am__objects_26 = exponent_r4.lo exponent_r8.lo
 am__objects_27 = fraction_r4.lo fraction_r8.lo
 am__objects_28 = nearest_r4.lo nearest_r8.lo
@@ -533,11 +535,15 @@ generated/cshift1_8.c
 
 in_pack_c = \
 generated/in_pack_i4.c \
-generated/in_pack_i8.c
+generated/in_pack_i8.c \
+generated/in_pack_c4.c \
+generated/in_pack_c8.c
 
 in_unpack_c = \
 generated/in_unpack_i4.c \
-generated/in_unpack_i8.c
+generated/in_unpack_i8.c \
+generated/in_unpack_c4.c \
+generated/in_unpack_c8.c
 
 i_exponent_c = \
 generated/exponent_r4.c \
@@ -1129,12 +1135,24 @@ in_pack_i4.lo: generated/in_pack_i4.c
 in_pack_i8.lo: generated/in_pack_i8.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i8.lo `test -f 'generated/in_pack_i8.c' || echo '$(srcdir)/'`generated/in_pack_i8.c
 
+in_pack_c4.lo: generated/in_pack_c4.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c4.lo `test -f 'generated/in_pack_c4.c' || echo '$(srcdir)/'`generated/in_pack_c4.c
+
+in_pack_c8.lo: generated/in_pack_c8.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c8.lo `test -f 'generated/in_pack_c8.c' || echo '$(srcdir)/'`generated/in_pack_c8.c
+
 in_unpack_i4.lo: generated/in_unpack_i4.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i4.lo `test -f 'generated/in_unpack_i4.c' || echo '$(srcdir)/'`generated/in_unpack_i4.c
 
 in_unpack_i8.lo: generated/in_unpack_i8.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i8.lo `test -f 'generated/in_unpack_i8.c' || echo '$(srcdir)/'`generated/in_unpack_i8.c
 
+in_unpack_c4.lo: generated/in_unpack_c4.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c4.lo `test -f 'generated/in_unpack_c4.c' || echo '$(srcdir)/'`generated/in_unpack_c4.c
+
+in_unpack_c8.lo: generated/in_unpack_c8.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c8.lo `test -f 'generated/in_unpack_c8.c' || echo '$(srcdir)/'`generated/in_unpack_c8.c
+
 exponent_r4.lo: generated/exponent_r4.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r4.lo `test -f 'generated/exponent_r4.c' || echo '$(srcdir)/'`generated/exponent_r4.c
 

libgfortran/generated/in_pack_c4.c

+/* 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;
+}
+

libgfortran/generated/in_pack_c8.c

+/* 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;
+}
+

libgfortran/generated/in_pack_i4.c

@@ -82,7 +82,7 @@ internal_pack_4 (gfc_array_i4 * source)
     return source->data;
 
   /* Allocate storage for the destination.  */
-  destptr = (GFC_INTEGER_4 *)internal_malloc_size (ssize * 4);
+  destptr = (GFC_INTEGER_4 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_4));
   dest = destptr;
   src = source->data;
   stride0 = stride[0];

libgfortran/generated/in_pack_i8.c

@@ -82,7 +82,7 @@ internal_pack_8 (gfc_array_i8 * source)
     return source->data;
 
   /* Allocate storage for the destination.  */
-  destptr = (GFC_INTEGER_8 *)internal_malloc_size (ssize * 8);
+  destptr = (GFC_INTEGER_8 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_8));
   dest = destptr;
   src = source->data;
   stride0 = stride[0];

libgfortran/generated/in_unpack_c4.c

+/* 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];
+            }
+        }
+    }
+}
+

libgfortran/generated/in_unpack_c8.c

+/* 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];
+            }
+        }
+    }
+}
+

libgfortran/generated/in_unpack_i4.c

@@ -71,7 +71,7 @@ internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src)
 
   if (dsize != 0)
     {
-      memcpy (dest, src, dsize * 4);
+      memcpy (dest, src, dsize * sizeof (GFC_INTEGER_4));
       return;
     }
 

libgfortran/generated/in_unpack_i8.c

@@ -71,7 +71,7 @@ internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src)
 
   if (dsize != 0)
     {
-      memcpy (dest, src, dsize * 8);
+      memcpy (dest, src, dsize * sizeof (GFC_INTEGER_8));
       return;
     }
 

libgfortran/libgfortran.h

@@ -482,7 +482,7 @@ internal_proto(reshape_packed);
 
 /* Repacking functions.  */
 
-/* ??? These four aren't currently used by the compiler, though we
+/* ??? These eight aren't currently used by the compiler, though we
    certainly could do so.  */
 GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
 internal_proto(internal_pack_4);
@@ -490,12 +490,24 @@ internal_proto(internal_pack_4);
 GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
 internal_proto(internal_pack_8);
 
+GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
+internal_proto(internal_pack_c4);
+
+GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
+internal_proto(internal_pack_c8);
+
 extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
 internal_proto(internal_unpack_4);
 
 extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
 internal_proto(internal_unpack_8);
 
+extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
+internal_proto(internal_unpack_c4);
+
+extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
+internal_proto(internal_unpack_c8);
+
 /* string_intrinsics.c */
 
 extern GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *,

libgfortran/m4/in_pack.m4

@@ -37,9 +37,10 @@ include(iparm.m4)dnl
 /* Allocates a block of memory with internal_malloc if the array needs
    repacking.  */
 
-dnl Only the kind (ie size) is used to name the function.
+dnl The kind (ie size) is used to name the function for logicals, integers
+dnl and reals.  For complex, it's c4 or c8.
 rtype_name *
-`internal_pack_'rtype_kind (rtype * source)
+`internal_pack_'rtype_ccode (rtype * source)
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -84,7 +85,7 @@ rtype_name *
     return source->data;
 
   /* Allocate storage for the destination.  */
-  destptr = (rtype_name *)internal_malloc_size (ssize * rtype_kind);
+  destptr = (rtype_name *)internal_malloc_size (ssize * sizeof (rtype_name));
   dest = destptr;
   src = source->data;
   stride0 = stride[0];

libgfortran/m4/in_unpack.m4

@@ -35,9 +35,10 @@ Boston, MA 02111-1307, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
-dnl Only the kind (ie size) is used to name the function.
+dnl Only the kind (ie size) is used to name the function for integers,
+dnl reals and logicals.  For complex, it's c4 and c8.
 void
-`internal_unpack_'rtype_kind (rtype * d, const rtype_name * src)
+`internal_unpack_'rtype_ccode (rtype * d, const rtype_name * src)
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -73,7 +74,7 @@ void
 
   if (dsize != 0)
     {
-      memcpy (dest, src, dsize * rtype_kind);
+      memcpy (dest, src, dsize * sizeof (rtype_name));
       return;
     }
 

libgfortran/runtime/in_pack_generic.c

@@ -52,6 +52,7 @@ internal_pack (gfc_array_char * source)
   int n;
   int packed;
   index_type size;
+  int type;
 
   if (source->dim[0].stride == 0)
     {
@@ -59,14 +60,36 @@ internal_pack (gfc_array_char * source)
       return source->data;
     }
 
+  type = GFC_DESCRIPTOR_TYPE (source);
   size = GFC_DESCRIPTOR_SIZE (source);
-  switch (size)
+  switch (type)
     {
-    case 4:
-      return internal_pack_4 ((gfc_array_i4 *)source);
-
-    case 8:
-      return internal_pack_8 ((gfc_array_i8 *)source);
+    case GFC_DTYPE_INTEGER:
+    case GFC_DTYPE_LOGICAL:
+    case GFC_DTYPE_REAL:
+      switch (size)
+	{
+	case 4:
+	  return internal_pack_4 ((gfc_array_i4 *)source);
+	  
+	case 8:
+	  return internal_pack_8 ((gfc_array_i8 *)source);
+	}
+      break;
+
+    case GFC_DTYPE_COMPLEX:
+      switch (size)
+	{
+	case 8:
+	  return internal_pack_c4 ((gfc_array_c4 *)source);
+	  
+	case 16:
+	  return internal_pack_c8 ((gfc_array_c8 *)source);
+	}
+      break;
+
+    default:
+      break;
     }
 
   dim = GFC_DESCRIPTOR_RANK (source);

libgfortran/runtime/in_unpack_generic.c

@@ -50,22 +50,45 @@ internal_unpack (gfc_array_char * d, const void * s)
   const char *src;
   int n;
   int size;
+  int type;
 
   dest = d->data;
   /* This check may be redundant, but do it anyway.  */
   if (s == dest || !s)
     return;
 
+  type = GFC_DESCRIPTOR_TYPE (d);
   size = GFC_DESCRIPTOR_SIZE (d);
-  switch (size)
+  switch (type)
     {
-    case 4:
-      internal_unpack_4 ((gfc_array_i4 *)d, (const GFC_INTEGER_4 *)s);
-      return;
-
-    case 8:
-      internal_unpack_8 ((gfc_array_i8 *)d, (const GFC_INTEGER_8 *)s);
-      return;
+    case GFC_DTYPE_INTEGER:
+    case GFC_DTYPE_LOGICAL:
+    case GFC_DTYPE_REAL:
+      switch (size)
+	{
+	case 4:
+	  internal_unpack_4 ((gfc_array_i4 *)d, (const GFC_INTEGER_4 *)s);
+	  return;
+
+	case 8:
+	  internal_unpack_8 ((gfc_array_i8 *)d, (const GFC_INTEGER_8 *)s);
+	  return;
+	}
+      break;
+
+    case GFC_DTYPE_COMPLEX:
+      switch (size) 
+	{
+	case 8:
+	  internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s);
+	  return;
+
+	case 16:
+	  internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s);
+	  return;
+	}
+    default:
+      break;
     }
 
   if (d->dim[0].stride == 0)