05-04-22 Thomas Koenig <Thomas.Koenig@online.de>

        PR libfortran/20074
        PR libfortran/20436
        PR libfortran/21108
        * gfortran.dg/nested_reshape.f90: new test
        * gfortran.dg/reshape-alloc.f90: new test
        * gfortran.dg/reshape.f90: new test

2005-04-22  Thomas Koenig  <Thomas.Koenig@online.de>

        PR libfortran/20074
        PR libfortran/20436
        PR libfortran/21108
        * m4/reshape.m4 (reshape_`'rtype_kind):  rs, rex:  New
        variables, to be used in calculation of return array sizes.
        Populate return array descriptor if ret->data is NULL.
        Fix condition for early return (it used to test something
        undefined if order was used).
        Remove duplicate check wether pad is used.
        * intrinsics/reshape_generic.c (reshape_generic): Likewise.
        Fix a few places where the wrong variables were set.
        * generated/reshape_i4.c: Regenerated.
        * generated/reshape_i8.c: Regenerated.

From-SVN: r98585

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 505e057d020de285daa1dcd72dddd092ffb2372d..e8786568e15b9693c3347c55b100da71be273a6c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+205-04-22  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/20074
+       PR libfortran/20436
+       PR libfortran/21108
+       * gfortran.dg/nested_reshape.f90: new test
+       * gfortran.dg/reshape-alloc.f90: new test
+       * gfortran.dg/reshape.f90: new test
+
 2005-04-22  Mark Mitchell  <mark@codesourcery.com>
 
        * gcc.dg/arm-vfp1.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/nested_reshape.f90 b/gcc/testsuite/gfortran.dg/nested_reshape.f90
new file mode 100644 (file)
index 0000000..d71e4ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_reshape.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! PR 20436: This used to give a runtime error.
+program nested_reshape
+  implicit none
+  real :: k(8,2)
+  real :: o(8,2)
+
+  k = reshape((/1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0, &
+            9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0/), (/8,2/))
+
+  o = reshape(reshape(k, (/2,8/), order=(/2,1/)), (/8,2/))
+end program

diff --git a/gcc/testsuite/gfortran.dg/reshape-alloc.f90 b/gcc/testsuite/gfortran.dg/reshape-alloc.f90
new file mode 100644 (file)
index 0000000..c4c7a0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape-alloc.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR 20074: This used to segfault at runtime.
+! Test case contributed by "Alfredo Buttari" <pitagoras@tin.it>
+
+program tryreshape
+
+  integer,allocatable :: vect1(:),resh1(:,:)
+  integer,pointer :: vect(:),resh(:,:)
+  integer :: vect2(2*4), resh2(2,4)
+  integer :: r, s(2)
+
+  r=2;  nb=4
+
+  s(:)=(/r,nb/)
+
+  allocate(vect(nb*r),vect1(nb*r))
+  allocate(resh(r,nb),resh1(r,nb))
+
+  vect =1
+  vect1=1
+  vect2=1
+
+  resh2 = reshape(vect2,s)
+  if (resh2(1,1) /= 1.0) call abort
+
+  resh1 = reshape(vect1,s)
+  if (resh1(1,1) /= 1.0) call abort
+
+  resh = reshape(vect,s)
+  if (resh(1,1) /= 1.0) call abort
+
+end program tryreshape

diff --git a/gcc/testsuite/gfortran.dg/reshape.f90 b/gcc/testsuite/gfortran.dg/reshape.f90
new file mode 100644 (file)
index 0000000..3dba098
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! This tests a few reshape PRs.
+program resh
+  implicit none
+  real, dimension (2,3) :: a,c
+  real, dimension (12) :: b
+  type foo
+    real :: r
+  end type foo
+  type(foo), dimension (2,3) :: ar
+  type(foo), dimension (12) :: br
+
+  character (len=80) line1, line2, line3
+  integer :: i
+
+  ! PR 21108:  This used to give undefined results.
+  b = (/(i,i=1,12)/)
+  a = reshape(b(1:12:2),shape(a),order=(/2,1/))
+  c = reshape(b(1:12:2),shape(a),order=(/2,1/))
+  if (any (a /= c)) call abort
+
+  ! Test generic reshape
+  br%r = b
+  ar = reshape(br(1:12:2),shape(a),order=(/2,1/))
+  if (any (ar%r /= a)) call abort
+
+  ! Test callee-allocated memory with a write statement
+  write (line1,'(6F8.3)') reshape(b(1:12:2),shape(a),order=(/2,1/))
+  write (line2,'(6F8.3)') a
+  if (line1 /= line2 ) call abort
+  write (line3,'(6F8.3)') reshape(br(1:12:2),shape(ar),order=(/2,1/))
+  if (line1 /= line3 ) call abort
+end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index d0dc7f179e6dbc213261bb4aafc126394a1ae4f4..66ecfd08c6803ad99e8f395aa49a1293d5a90daf 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,19 @@
+2005-04-22  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/20074
+       PR libfortran/20436
+       PR libfortran/21108
+       * m4/reshape.m4 (reshape_`'rtype_kind):  rs, rex:  New
+       variables, to be used in calculation of return array sizes.
+       Populate return array descriptor if ret->data is NULL.
+       Fix condition for early return (it used to test something
+       undefined if order was used).
+       Remove duplicate check wether pad is used.
+       * intrinsics/reshape_generic.c (reshape_generic): Likewise.
+       Fix a few places where the wrong variables were set.
+       * generated/reshape_i4.c: Regenerated.
+       * generated/reshape_i8.c: Regenerated.
+
 2005-04-18 Paul Thomas <pault@gcc.gnu.org>
 
        * io/list_read.c (nml_touch_nodes, nml_read_obj,

diff --git a/libgfortran/generated/reshape_i4.c b/libgfortran/generated/reshape_i4.c
index fbe16f293a5beb557bcf3dc4fb5b36df66cdadd7..b90e56caf4eeaaf71b968a5dbe66edaaf1f10f52 100644 (file)
--- a/libgfortran/generated/reshape_i4.c
+++ b/libgfortran/generated/reshape_i4.c
@@ -53,6 +53,8 @@ reshape_4 (gfc_array_i4 * ret, gfc_array_i4 * source, shape_type * shape,
   index_type rstride0;
   index_type rdim;
   index_type rsize;
+  index_type rs;
+  index_type rex;
   GFC_INTEGER_4 *rptr;
   /* s.* indicates the source array.  */
   index_type scount[GFC_MAX_DIMENSIONS];
@@ -74,8 +76,6 @@ reshape_4 (gfc_array_i4 * ret, gfc_array_i4 * source, shape_type * shape,
   int n;
   int dim;
 
-  if (ret->dim[0].stride == 0)
-    ret->dim[0].stride = 1;
   if (source->dim[0].stride == 0)
     source->dim[0].stride = 1;
   if (shape->dim[0].stride == 0)
@@ -85,7 +85,29 @@ reshape_4 (gfc_array_i4 * ret, gfc_array_i4 * source, shape_type * shape,
   if (order && order->dim[0].stride == 0)
     order->dim[0].stride = 1;
 
-  rdim = GFC_DESCRIPTOR_RANK (ret);
+  if (ret->data == NULL)
+    {
+      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+      rs = 1;
+      for (n=0; n < rdim; n++)
+       {
+         ret->dim[n].lbound = 0;
+         rex = shape->data[n * shape->dim[0].stride];
+         ret->dim[n].ubound =  rex - 1;
+         ret->dim[n].stride = rs;
+         rs *= rex;
+       }
+      ret->base = 0;
+      ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_4));
+      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+    }
+  else
+    {
+      rdim = GFC_DESCRIPTOR_RANK (ret);
+      if (ret->dim[0].stride == 0)
+       ret->dim[0].stride = 1;
+    }
+
   rsize = 1;
   for (n = 0; n < rdim; n++)
     {
@@ -105,7 +127,7 @@ reshape_4 (gfc_array_i4 * ret, gfc_array_i4 * source, shape_type * shape,
         rsize *= rextent[n];
       else
         rsize = 0;
-      if (rextent[dim] <= 0)
+      if (rextent[n] <= 0)
         return;
     }
 
@@ -127,8 +149,6 @@ reshape_4 (gfc_array_i4 * ret, gfc_array_i4 * source, shape_type * shape,
 
   if (pad)
     {
-      if (pad->dim[0].stride == 0)
-        pad->dim[0].stride = 1;
       pdim = GFC_DESCRIPTOR_RANK (pad);
       psize = 1;
       for (n = 0; n < pdim; n++)

diff --git a/libgfortran/generated/reshape_i8.c b/libgfortran/generated/reshape_i8.c
index 6d835ff580b39ce9ad1dba90f3882ebfa3ea9c41..38532c1aac556d1fc96dbf53309adc687586e350 100644 (file)
--- a/libgfortran/generated/reshape_i8.c
+++ b/libgfortran/generated/reshape_i8.c
@@ -53,6 +53,8 @@ reshape_8 (gfc_array_i8 * ret, gfc_array_i8 * source, shape_type * shape,
   index_type rstride0;
   index_type rdim;
   index_type rsize;
+  index_type rs;
+  index_type rex;
   GFC_INTEGER_8 *rptr;
   /* s.* indicates the source array.  */
   index_type scount[GFC_MAX_DIMENSIONS];
@@ -74,8 +76,6 @@ reshape_8 (gfc_array_i8 * ret, gfc_array_i8 * source, shape_type * shape,
   int n;
   int dim;
 
-  if (ret->dim[0].stride == 0)
-    ret->dim[0].stride = 1;
   if (source->dim[0].stride == 0)
     source->dim[0].stride = 1;
   if (shape->dim[0].stride == 0)
@@ -85,7 +85,29 @@ reshape_8 (gfc_array_i8 * ret, gfc_array_i8 * source, shape_type * shape,
   if (order && order->dim[0].stride == 0)
     order->dim[0].stride = 1;
 
-  rdim = GFC_DESCRIPTOR_RANK (ret);
+  if (ret->data == NULL)
+    {
+      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+      rs = 1;
+      for (n=0; n < rdim; n++)
+       {
+         ret->dim[n].lbound = 0;
+         rex = shape->data[n * shape->dim[0].stride];
+         ret->dim[n].ubound =  rex - 1;
+         ret->dim[n].stride = rs;
+         rs *= rex;
+       }
+      ret->base = 0;
+      ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_8));
+      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+    }
+  else
+    {
+      rdim = GFC_DESCRIPTOR_RANK (ret);
+      if (ret->dim[0].stride == 0)
+       ret->dim[0].stride = 1;
+    }
+
   rsize = 1;
   for (n = 0; n < rdim; n++)
     {
@@ -105,7 +127,7 @@ reshape_8 (gfc_array_i8 * ret, gfc_array_i8 * source, shape_type * shape,
         rsize *= rextent[n];
       else
         rsize = 0;
-      if (rextent[dim] <= 0)
+      if (rextent[n] <= 0)
         return;
     }
 
@@ -127,8 +149,6 @@ reshape_8 (gfc_array_i8 * ret, gfc_array_i8 * source, shape_type * shape,
 
   if (pad)
     {
-      if (pad->dim[0].stride == 0)
-        pad->dim[0].stride = 1;
       pdim = GFC_DESCRIPTOR_RANK (pad);
       psize = 1;
       for (n = 0; n < pdim; n++)

diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c
index c0339cad6338052c32cc1f7e11b1d87e67618a0a..75db5eafd24f58a1ae0ef561dc1e1b03e7ae4cf5 100644 (file)
--- a/libgfortran/intrinsics/reshape_generic.c
+++ b/libgfortran/intrinsics/reshape_generic.c
@@ -54,6 +54,8 @@ reshape (parray *ret, parray *source, shape_type *shape,
   index_type rstride0;
   index_type rdim;
   index_type rsize;
+  index_type rs;
+  index_type rex;
   char *rptr;
   /* s.* indicates the source array.  */
   index_type scount[GFC_MAX_DIMENSIONS];
@@ -76,9 +78,6 @@ reshape (parray *ret, parray *source, shape_type *shape,
   int dim;
   int size;
 
-  size = GFC_DESCRIPTOR_SIZE (ret);
-  if (ret->dim[0].stride == 0)
-    ret->dim[0].stride = 1;
   if (source->dim[0].stride == 0)
     source->dim[0].stride = 1;
   if (shape->dim[0].stride == 0)
@@ -88,7 +87,31 @@ reshape (parray *ret, parray *source, shape_type *shape,
   if (order && order->dim[0].stride == 0)
     order->dim[0].stride = 1;
 
-  rdim = GFC_DESCRIPTOR_RANK (ret);
+  if (ret->data == NULL)
+    {
+      size = GFC_DESCRIPTOR_SIZE (ret);
+      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+      rs = 1;
+      for (n=0; n < rdim; n++)
+       {
+         ret->dim[n].lbound = 0;
+         rex = shape->data[n * shape->dim[0].stride];
+         ret->dim[n].ubound =  rex - 1;
+         ret->dim[n].stride = rs;
+         rs *= rex;
+       }
+      ret->base = 0;
+      ret->data = internal_malloc_size ( rs * size );
+      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+    }
+  else
+    {
+      size = GFC_DESCRIPTOR_SIZE (ret);
+      rdim = GFC_DESCRIPTOR_RANK (ret);
+      if (ret->dim[0].stride == 0)
+       ret->dim[0].stride = 1;
+    }
+
   rsize = 1;
   for (n = 0; n < rdim; n++)
     {
@@ -108,7 +131,7 @@ reshape (parray *ret, parray *source, shape_type *shape,
         rsize *= rextent[n];
       else
         rsize = 0;
-      if (rextent[dim] <= 0)
+      if (rextent[n] <= 0)
         return;
     }
 
@@ -122,7 +145,7 @@ reshape (parray *ret, parray *source, shape_type *shape,
       if (sextent[n] <= 0)
         abort ();
 
-      if (rsize == sstride[n])
+      if (ssize == sstride[n])
         ssize *= sextent[n];
       else
         ssize = 0;
@@ -130,8 +153,6 @@ reshape (parray *ret, parray *source, shape_type *shape,
 
   if (pad)
     {
-      if (pad->dim[0].stride == 0)
-        pad->dim[0].stride = 1;
       pdim = GFC_DESCRIPTOR_RANK (pad);
       psize = 1;
       for (n = 0; n < pdim; n++)
@@ -144,7 +165,7 @@ reshape (parray *ret, parray *source, shape_type *shape,
           if (psize == pstride[n])
             psize *= pextent[n];
           else
-            rsize = 0;
+            psize = 0;
         }
       pptr = pad->data;
     }

diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4
index 22e2536ecb7d6be4b6beb24feefbd6ca608224d3..541377f01c5cae325f064e84d81459c1ae5d4e5a 100644 (file)
--- a/libgfortran/m4/reshape.m4
+++ b/libgfortran/m4/reshape.m4
@@ -55,6 +55,8 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape,
   index_type rstride0;
   index_type rdim;
   index_type rsize;
+  index_type rs;
+  index_type rex;
   rtype_name *rptr;
   /* s.* indicates the source array.  */
   index_type scount[GFC_MAX_DIMENSIONS];
@@ -76,8 +78,6 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape,
   int n;
   int dim;
 
-  if (ret->dim[0].stride == 0)
-    ret->dim[0].stride = 1;
   if (source->dim[0].stride == 0)
     source->dim[0].stride = 1;
   if (shape->dim[0].stride == 0)
@@ -87,7 +87,29 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape,
   if (order && order->dim[0].stride == 0)
     order->dim[0].stride = 1;
 
-  rdim = GFC_DESCRIPTOR_RANK (ret);
+  if (ret->data == NULL)
+    {
+      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+      rs = 1;
+      for (n=0; n < rdim; n++)
+       {
+         ret->dim[n].lbound = 0;
+         rex = shape->data[n * shape->dim[0].stride];
+         ret->dim[n].ubound =  rex - 1;
+         ret->dim[n].stride = rs;
+         rs *= rex;
+       }
+      ret->base = 0;
+      ret->data = internal_malloc_size ( rs * sizeof (rtype_name));
+      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+    }
+  else
+    {
+      rdim = GFC_DESCRIPTOR_RANK (ret);
+      if (ret->dim[0].stride == 0)
+       ret->dim[0].stride = 1;
+    }
+
   rsize = 1;
   for (n = 0; n < rdim; n++)
     {
@@ -107,7 +129,7 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape,
         rsize *= rextent[n];
       else
         rsize = 0;
-      if (rextent[dim] <= 0)
+      if (rextent[n] <= 0)
         return;
     }
 
@@ -129,8 +151,6 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape,
 
   if (pad)
     {
-      if (pad->dim[0].stride == 0)
-        pad->dim[0].stride = 1;
       pdim = GFC_DESCRIPTOR_RANK (pad);
       psize = 1;
       for (n = 0; n < pdim; n++)