mirrors/gcc
1
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-26 04:14:06 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Thomas Koenig 2005-04-22 20:02:44 +00:00 committed by Thomas Koenig
parent f00fac9d2f
commit da8f3dcc5b
9 changed files with 210 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/testsuite/ChangeLog
View File

@ -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.

12
gcc/testsuite/gfortran.dg/nested_reshape.f90 Normal file
View File

@ -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

32
gcc/testsuite/gfortran.dg/reshape-alloc.f90 Normal file
View File

@ -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

33
gcc/testsuite/gfortran.dg/reshape.f90 Normal file
View File

@ -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

16
libgfortran/ChangeLog
View File

@ -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,

32
libgfortran/generated/reshape_i4.c
View File

@ -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++)

32
libgfortran/generated/reshape_i8.c
View File

@ -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++)

39
libgfortran/intrinsics/reshape_generic.c
View File

@ -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;
}

32
libgfortran/m4/reshape.m4
View File

@ -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++)