procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/46007 (wrong code for SHAPE in a scalarized loop)

Browse source 
2010-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/46007
	* m4/shape.m4 (shape_'rtype_kind`):  Use variable for rank.
	Allocate return array if unallocated.
	* generated/shape_i4.c:  Regenerated.
	* generated/shape_i8.c:  Regenerated.
	* generated/shape_i16.c:  Regenerated.

2010-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/46007
	* gfortran.dg/shape_5.f90:  New test case.

From-SVN: r165770
This commit is contained in:
Thomas Koenig 2010-10-21 12:25:12 +00:00
parent 837c4b78f6
commit 3ba7edcfcc
7 changed files with 66 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2010-10-21 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/46007
* gfortran.dg/shape_5.f90: New test case.
2010-10-21 Janus Weil <janus@gcc.gnu.org>
PR fortran/46060

8
gcc/testsuite/gfortran.dg/shape_5.f90 Normal file
View file

@ -0,0 +1,8 @@
! { dg-do run }
! PR 40067 - this used to segfault on an unallocated return array.
integer, dimension(10) :: int1d
integer, dimension(:), pointer :: int1d_retrieved
allocate(int1d_retrieved(10))
if (any(shape(int1d_retrieved) /= shape(INT1D))) call abort()
end

9
libgfortran/ChangeLog
View file

@ -1,3 +1,12 @@
2010-10-21 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/46007
* m4/shape.m4 (shape_'rtype_kind`): Use variable for rank.
Allocate return array if unallocated.
* generated/shape_i4.c: Regenerated.
* generated/shape_i8.c: Regenerated.
* generated/shape_i16.c: Regenerated.
2010-10-20 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/46079

12
libgfortran/generated/shape_i16.c
View file

@ -41,13 +41,23 @@ shape_16 (gfc_array_i16 * const restrict ret,
int n;
index_type stride;
index_type extent;
int rank;
rank = GFC_DESCRIPTOR_RANK (array);
if (ret->data == NULL)
{
GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
ret->offset = 0;
ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
stride = GFC_DESCRIPTOR_STRIDE(ret,0);
if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
return;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
for (n = 0; n < rank; n++)
{
extent = GFC_DESCRIPTOR_EXTENT(array,n);
ret->data[n * stride] = extent > 0 ? extent : 0 ;

12
libgfortran/generated/shape_i4.c
View file

@ -41,13 +41,23 @@ shape_4 (gfc_array_i4 * const restrict ret,
int n;
index_type stride;
index_type extent;
int rank;
rank = GFC_DESCRIPTOR_RANK (array);
if (ret->data == NULL)
{
GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
ret->offset = 0;
ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
stride = GFC_DESCRIPTOR_STRIDE(ret,0);
if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
return;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
for (n = 0; n < rank; n++)
{
extent = GFC_DESCRIPTOR_EXTENT(array,n);
ret->data[n * stride] = extent > 0 ? extent : 0 ;

12
libgfortran/generated/shape_i8.c
View file

@ -41,13 +41,23 @@ shape_8 (gfc_array_i8 * const restrict ret,
int n;
index_type stride;
index_type extent;
int rank;
rank = GFC_DESCRIPTOR_RANK (array);
if (ret->data == NULL)
{
GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
ret->offset = 0;
ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
stride = GFC_DESCRIPTOR_STRIDE(ret,0);
if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
return;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
for (n = 0; n < rank; n++)
{
extent = GFC_DESCRIPTOR_EXTENT(array,n);
ret->data[n * stride] = extent > 0 ? extent : 0 ;

12
libgfortran/m4/shape.m4
View file

@ -42,13 +42,23 @@ shape_'rtype_kind` ('rtype` * const restrict ret,
int n;
index_type stride;
index_type extent;
int rank;
rank = GFC_DESCRIPTOR_RANK (array);
if (ret->data == NULL)
{
GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
ret->offset = 0;
ret->data = internal_malloc_size (sizeof ('rtype_name`) * rank);
}
stride = GFC_DESCRIPTOR_STRIDE(ret,0);
if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
return;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
for (n = 0; n < rank; n++)
{
extent = GFC_DESCRIPTOR_EXTENT(array,n);
ret->data[n * stride] = extent > 0 ? extent : 0 ;