Index: iforeach.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/iforeach.m4,v
retrieving revision 1.6
diff -p -c -r1.6 iforeach.m4
*** iforeach.m4	12 Jan 2005 21:27:31 -0000	1.6
--- iforeach.m4	8 Apr 2005 21:54:02 -0000
*************** name`'rtype_qual`_'atype_code (rtype * r
*** 21,32 ****
  
    rank = GFC_DESCRIPTOR_RANK (array);
    assert (rank > 0);
!   assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
!   assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
    if (array->dim[0].stride == 0)
      array->dim[0].stride = 1;
-   if (retarray->dim[0].stride == 0)
-     retarray->dim[0].stride = 1;
  
    dstride = retarray->dim[0].stride;
    dest = retarray->data;
--- 21,48 ----
  
    rank = GFC_DESCRIPTOR_RANK (array);
    assert (rank > 0);
!   if (retarray->data == NULL)
!     {
!       retarray->dim[0].lbound = 0;
!       retarray->dim[0].ubound = rank-1;
!       retarray->dim[0].stride = 1;
!       retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
!       retarray->base = 0;
!       retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
!     }
!   else
!     {
!       if (GFC_DESCRIPTOR_RANK (retarray) != 1)
! 	runtime_error ("rank of return array does not equal 1");
! 
!       if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
!         runtime_error ("dimension of return array incorrect");
! 
!       if (retarray->dim[0].stride == 0)
! 	retarray->dim[0].stride = 1;
!     }
    if (array->dim[0].stride == 0)
      array->dim[0].stride = 1;
  
    dstride = retarray->dim[0].stride;
    dest = retarray->data;
*************** void
*** 110,125 ****
  
    rank = GFC_DESCRIPTOR_RANK (array);
    assert (rank > 0);
!   assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
!   assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
!   assert (GFC_DESCRIPTOR_RANK (mask) == rank);
  
    if (array->dim[0].stride == 0)
      array->dim[0].stride = 1;
-   if (retarray->dim[0].stride == 0)
-     retarray->dim[0].stride = 1;
-   if (retarray->dim[0].stride == 0)
-     retarray->dim[0].stride = 1;
  
    dstride = retarray->dim[0].stride;
    dest = retarray->data;
--- 126,154 ----
  
    rank = GFC_DESCRIPTOR_RANK (array);
    assert (rank > 0);
!   if (retarray->data == NULL)
!     {
!       retarray->dim[0].lbound = 0;
!       retarray->dim[0].ubound = rank-1;
!       retarray->dim[0].stride = 1;
!       retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
!       retarray->base = 0;
!       retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
!     }
!   else
!     {
!       if (GFC_DESCRIPTOR_RANK (retarray) != 1)
! 	runtime_error ("rank of return array does not equal 1");
! 
!       if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
!         runtime_error ("dimension of return array incorrect");
! 
!       if (retarray->dim[0].stride == 0)
! 	retarray->dim[0].stride = 1;
!     }
  
    if (array->dim[0].stride == 0)
      array->dim[0].stride = 1;
  
    dstride = retarray->dim[0].stride;
    dest = retarray->data;
Index: ifunction.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/ifunction.m4,v
retrieving revision 1.8
diff -p -c -r1.8 ifunction.m4
*** ifunction.m4	12 Jan 2005 21:27:31 -0000	1.8
--- ifunction.m4	8 Apr 2005 21:54:02 -0000
*************** name`'rtype_qual`_'atype_code (rtype *re
*** 40,50 ****
    /* Make dim zero based to avoid confusion.  */
    dim = (*pdim) - 1;
    rank = GFC_DESCRIPTOR_RANK (array) - 1;
-   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
    if (array->dim[0].stride == 0)
      array->dim[0].stride = 1;
-   if (retarray->dim[0].stride == 0)
-     retarray->dim[0].stride = 1;
  
    len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
    delta = array->dim[dim].stride;
--- 40,47 ----
*************** name`'rtype_qual`_'atype_code (rtype *re
*** 78,85 ****
  		 		 * retarray->dim[rank-1].stride
  				 * extent[rank-1]);
        retarray->base = 0;
      }
!           
    for (n = 0; n < rank; n++)
      {
        count[n] = 0;
--- 75,91 ----
  		 		 * retarray->dim[rank-1].stride
  				 * extent[rank-1]);
        retarray->base = 0;
+       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
      }
!   else
!     {
!       if (retarray->dim[0].stride == 0)
! 	retarray->dim[0].stride = 1;
! 
!       if (rank != GFC_DESCRIPTOR_RANK (retarray))
! 	runtime_error ("rank of return array incorrect");
!     }
! 
    for (n = 0; n < rank; n++)
      {
        count[n] = 0;
*************** void
*** 168,178 ****
  
    dim = (*pdim) - 1;
    rank = GFC_DESCRIPTOR_RANK (array) - 1;
-   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
    if (array->dim[0].stride == 0)
      array->dim[0].stride = 1;
-   if (retarray->dim[0].stride == 0)
-     retarray->dim[0].stride = 1;
  
    len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
    if (len <= 0)
--- 174,181 ----
*************** void
*** 194,199 ****
--- 197,230 ----
          array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
      }
  
+   if (retarray->data == NULL)
+     {
+       for (n = 0; n < rank; n++)
+         {
+           retarray->dim[n].lbound = 0;
+           retarray->dim[n].ubound = extent[n]-1;
+           if (n == 0)
+             retarray->dim[n].stride = 1;
+           else
+             retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+         }
+ 
+       retarray->data
+ 	 = internal_malloc_size (sizeof (rtype_name)
+ 		 		 * retarray->dim[rank-1].stride
+ 				 * extent[rank-1]);
+       retarray->base = 0;
+       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+     }
+   else
+     {
+       if (retarray->dim[0].stride == 0)
+ 	retarray->dim[0].stride = 1;
+ 
+       if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ 	runtime_error ("rank of return array incorrect");
+     }
+ 
    for (n = 0; n < rank; n++)
      {
        count[n] = 0;