From: Thomas Koenig Date: Thu, 21 Oct 2010 12:25:12 +0000 (+0000) Subject: re PR fortran/46007 (wrong code for SHAPE in a scalarized loop) X-Git-Tag: releases/gcc-4.6.0~3320 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=3ba7edcfcccc8c37983e89ee9d80287e6e3bb0f4;p=thirdparty%2Fgcc.git re PR fortran/46007 (wrong code for SHAPE in a scalarized loop) 2010-10-21 Thomas Koenig 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 PR fortran/46007 * gfortran.dg/shape_5.f90: New test case. From-SVN: r165770 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 51877d145458..b4f914e808c1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-10-21 Thomas Koenig + + PR fortran/46007 + * gfortran.dg/shape_5.f90: New test case. + 2010-10-21 Janus Weil PR fortran/46060 diff --git a/gcc/testsuite/gfortran.dg/shape_5.f90 b/gcc/testsuite/gfortran.dg/shape_5.f90 new file mode 100644 index 000000000000..ed128bcd2028 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/shape_5.f90 @@ -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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index c47cac370b5b..5b06cef1b4ff 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,12 @@ +2010-10-21 Thomas Koenig + + 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 PR libgfortran/46079 diff --git a/libgfortran/generated/shape_i16.c b/libgfortran/generated/shape_i16.c index 9ce28577baa3..c2c52005a13a 100644 --- a/libgfortran/generated/shape_i16.c +++ b/libgfortran/generated/shape_i16.c @@ -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 ; diff --git a/libgfortran/generated/shape_i4.c b/libgfortran/generated/shape_i4.c index 1b23335de568..0cef3327736b 100644 --- a/libgfortran/generated/shape_i4.c +++ b/libgfortran/generated/shape_i4.c @@ -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 ; diff --git a/libgfortran/generated/shape_i8.c b/libgfortran/generated/shape_i8.c index efe00a5dd331..b457ae081c7c 100644 --- a/libgfortran/generated/shape_i8.c +++ b/libgfortran/generated/shape_i8.c @@ -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 ; diff --git a/libgfortran/m4/shape.m4 b/libgfortran/m4/shape.m4 index eadd3b9b9450..a289b0a80769 100644 --- a/libgfortran/m4/shape.m4 +++ b/libgfortran/m4/shape.m4 @@ -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 ;