re PR fortran/32217 (segfaults (at runtime) on UNPACK with zero-sized arrays)

2007-07-08  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/32217
	* intrinsics/unpack_generic.c:  If the destination array is
	empty, return early.

2007-07-08  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/32217
	* gfortran.dg/unpack_zerosize_1.f90:  New test case.

From-SVN: r126469

gcc/testsuite/ChangeLog

+2007-07-08  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/32217
+	* gfortran.dg/unpack_zerosize_1.f90:  New test case.
+
 2007-07-08  Daniel Franke  <franke.daniel@gmail.com>
 
 	PR fortran/17711

gcc/testsuite/gfortran.dg/unpack_zerosize_1.f90

+! { dg-do run }
+! PR 32217 - unpack used to crash at runtime with a zero-sized
+!            array.  Test case submitted by Jaroslav Hajek.
+program bug_report
+  implicit none
+  integer,parameter:: rp = kind(1.d0),na = 6
+  real(rp),allocatable:: hhe(:,:,:),hhc(:,:,:),dv(:)
+  integer:: nhh,ndv
+  nhh = 0
+  allocate(hhe(nhh,2,2))
+  ndv = 2*na + count(hhe /= 0)
+  allocate(hhc(nhh,2,2),dv(ndv))
+  hhc = unpack(dv(2*na+1:),hhe /= 0._rp,0._rp)
+end program bug_report

libgfortran/ChangeLog

+2007-07-08  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/32217
+	* intrinsics/unpack_generic.c:  If the destination array is
+	empty, return early.
+
 2007-07-05  H.J. Lu  <hongjiu.lu@intel.com>
 
 	* aclocal.m4: Regenerated.

libgfortran/intrinsics/unpack_generic.c

@@ -61,6 +61,9 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
   index_type n;
   index_type dim;
 
+  int empty;
+
+  empty = 0;
   if (ret->data == NULL)
     {
       /* The front end has signalled that we need to populate the
@@ -74,6 +77,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
 	  ret->dim[n].lbound = 0;
 	  ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
 	  extent[n] = ret->dim[n].ubound + 1;
+	  empty = empty || extent[n] <= 0;
 	  rstride[n] = ret->dim[n].stride * size;
 	  fstride[n] = field->dim[n].stride * fsize;
 	  mstride[n] = mask->dim[n].stride;
@@ -89,6 +93,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
 	{
 	  count[n] = 0;
 	  extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+	  empty = empty || extent[n] <= 0;
 	  rstride[n] = ret->dim[n].stride * size;
 	  fstride[n] = field->dim[n].stride * fsize;
 	  mstride[n] = mask->dim[n].stride;
@@ -96,6 +101,10 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
       if (rstride[0] == 0)
 	rstride[0] = size;
     }
+
+  if (empty)
+    return;
+
   if (fstride[0] == 0)
     fstride[0] = fsize;
   if (mstride[0] == 0)